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Table  and  Graphs 

GRAPH  1-  MOOR <t>S  }  PAGES  222-303 


non  ooo  non  noo  oon 


et  sys  f  mal /t2for /graph!  for## 
subroutine  graph! 

c 

c  Produce  annotated  symbolic  depiction  of  compound  leg,  tables  of 
c  parameters  input  to  define  it  ,  and  tables  of  computed  forces, 
c  coordinates  ,  angles  and  tensions 

c 

implicit  integer *2  (») 

c 

c  COMMON  BLOCK  DECLARATIONS 

c 

c  TITLES 

c 

integer*!  ctitle(lH) 

common  / 1 1 1 1 es/  c  1 1 tie 

OAT  I ME 

integer*!  cdatim(16) 

common  /da time/  cdatim 

VARIN 

integer*!  cvarm(l72! 

common  /varm/  ever  in 

VAROUT 

integer*!  cvarol  (210 1  ,cvaro2U00 ) 

common  /varout/  cvarol  ,  cvaro2 

VARC 

integer* 1  cvarg(240) 
common  /varg/  evarg 

UNKNOW 

integer*!  cunkno(12) 

common  /unknow/  cunkno 


non  non 


integer*!  cgroptMl) 

common  /gropt/  cgropt 

CRP2CN 

integer*]  cgrp21 (218)  ,cgrp22182) 

common  /grp2cn/  cgrp2 1  ,  cgrp22 

PRINT  TABLES  OF  INPUT  PARAMETERS  AND  COMPUTED  VALUES 

ce) I  RWCOMI ( I  ) 

cal  I  ovl ink ( 'CRIN1  '  ) 

call  ovl ink (  CRIN2  '  ) 

cal  1  ovl ink (  'GROUT  I  '  ) 

call  ovl ink ( 'GR0UT2  ') 

call  RWCOMI (21 

return 


non  non  nnn  ooooo  nno 


et  sys  f inal/i2for/grtn1  forM 
subrou fine  gr  i  n  I 

Print  Croph  1  header,  legend  of  units,  and  input  parameter  list 
implicit  integer *2  («) 

COMMON  BLOCK  DECLARATIONS 
LUNITS 

mteger*2  screen  , key bd  ,lut  ,lu2  ,ni  v99  ,siz99  ,ncpl 

integer*!  pref  1  (21  )  ,duml  ,ext  Hi  I  ,ext2(i  ) 
common  /lumts/  screen  ,keybd  ,lu1  ,lu2  ,mv99  ,siz99  ,ncp1  , 

4  pref  I  ,dum!  ,extl  ,ext  2 

TITLES 

integer*!  title (SB  I  >i fi lei 32)  ,of i let 32) 
common  /titles/  1 1 t le  ,  i f i le  ,of i le 

OATIME 

i n  t  eger *2  i do  t  e ( 5  I  ,  i hour  ,  i m  t  n  ,  i sec 

common  /dot  i me/  idate,  i hour  , i mm  , i sec 

VARIN 

integer *2  iileg.iist 
integer*i  nnca  ,nncb 
real  ang!a,ong1b, 

&  scop  1  a  ,scop lb  ,«g 1 1  o  >«g  1 1  b  ,c  1  mp  1  a  >c  1  mp  1  b  , 

4  scop 2a  ,scop2b  ,»g  1 2a  >»g  1 2b  >c  1  mp2o  >c  1  mp2b  , 

4  scop3a  ,scop3b  ,«g  1 3a  ,wg  1 3b  > 

4  slip, frier,  clmp3, 

4  scopi  ,  wgti  , 

4  onksep , 

4  p!x,plz,p!d, 

4  p2x  ,p2z  >p2d  , 

4  p3x  ,p3z  ,p3d  , 

4  hlood  ,hdir , 

4  rbuoy  >xbuoy  ,zbuoy  , 

4  deptho,pdir 


1 


hZZ 


n  n  o  non 


i 


i 


common  /vartn/  11  leg, list, 

4  nnca  ,nncb  • 

&  angle  ,angli> , 

&  scop  I a  , scop lb  ,«gt la  ,»gt lb  ,clmpla  ,c)mplb  , 

&  scop2a  >scop2b  ,wg  1 2a  ,*g  1 2b  ,c  1  mp2a  ,c  1  mp2b  , 

&  scop3a  ,scop3b  ,mg 1 3a  ,wg » 3b  , 

&  si  ip  ,fr ici  ,  clmp3  , 

&  scopl  ■  >gtli 

&  anksep > 

&  plx,plz,pld, 

&  p2x  ,p2z  ,p2d  , 

&  p3x  ,p3z  ,p3d  , 

&  hload.hdir, 

&  rbuoy  ,xbuoy  .zbuoy  i 

&  deptho.pdir 

GCB 

integer*2  gbuf f 124 1  ,  lugraf  ,  lupt f 1  , ludbug 
common  /gcb/  gbuff  ,  I ugre f  ,  1  up r f 1  , 1 udbug 

LOCAL  VARIABLES 

integer*!  legnm(23,3l 
mteger*2  rdete 
mteger*2  three, five 
mteger*2  funkev 

c  DATA  INITIALIZATION 

c 

dota  three  ,f i ve/3  ,5/ 

data  legnm/ 'simple  'compound  -  equalizer 

&  'compound  -  spider  plate'/ 


c  EXECUTABLE  PORTION 
c 

c  HEAOER 

c 

cal  I  of  ini t 
call  date(rdate) 
call  undatelrdate  ■idate I 
call  t ime( ihour  ,imtn  , isec I 


r 


zzs 


1  I 
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wri te (screen  ,10051  ihour  ,imm  ,  isec 
1005  formal  I  lx, 'SOLUTION  COMPLETED  AT  '  ,i  2) 

call  readf k I funkey ) 
cal  I  erase 
call  chrsizl three ) 

wr 1 1 e (screen  ,1010  I idaie  , ihour  ,imin  , isec 

1010  format (1 x  ,  'Date  '  ,5a2  ,38x  ,  'SUMMARY '  ,3?x  , 

A  T  i  me  ,  1 2  ,  ,i2,  ,i2,l 

«n  telscreen  ,101 1  I 

101 1  formal ('+','  '  > 

call  chrsizl five) 

write! screen  ,  1 020 1 1 1 1 1 e 
1 020  f orma  1 1 1 x  ,  1 8x  ,50a I  I 
wr i telscreen  ,10301 
1030  format (lx  ,' INPUT  ' 1 
wr 1 1  e ( screen  ,1011  ) 
c  FILE  NAMES 

cal  I  chrsizl three ) 
wr i telscreen  ,1010 1 1 f i le  ,of  t le 
1010  format  I  ‘  '  ,12x  , 'Or iginal  Input  From  File  '  >32e1  , 

&  '  Rev i sed  to  File  Y  ,32a 1  I 
c  UNITS 

wr i telscreen  ,1050 1 

1050  format  1 1 x  ,1 3x  , 'Angles  -  Oegrees'/ 

&  1 x  ,1 3x  ,  Distances  -  Feet'/ 

&  lx, Sx, 'Units  Linear  Weights  -  Pounds/Foot'/ 

&  lx  ,13x  , ‘Weights  -  K 1 1 opounds  '  / 

&  lx  ,1 3x  , 'Forces  -  Kilopounds') 

c  LEG  TYPE 

wri telscreen  ,1 1 10) legnml I  , 1 1 1 eg  )  23 
1110  formal  I  lx  ,  'LEG  '/ 

A  lx, 2x, 'Type  ‘,23al,’ - A - - B - ’) 

c  ANCHOR  SEPARATION 

wn  telscreen  ,1 120) 

1120  format (lx  ,2x  , 'Anchor  Separation'! 

if  (anksep  ne  0009  OOlwri telscreen  ,1 121 lanksep 

1121  format  I '♦ '  ,3Bx  ,f7  21 
c  SEGMENTS  IN  BRANCH 

wri telscreen  ,1 130)nnca 

1130  format  I  lx  ,2x  , 'Segments  m  Branch '  ,!5x  ,i I  ) 
if  lulegne  1  )wri  telscreen  ,1 131  Inncb 

1131  format  I '♦'  ,13x  ,i 1  1 
c  ANCLE  TO  BOTTOM 


I  i 


yif 


me  i  le  (screen  ,1  HOI 

1140  formal (lx  ,2x  ,  'Angle  to  Botiom'l 

if  (angle  ne  9999  99)wri telscreen  ,1141 langla 
if  (anglb  ne  9999  99)wri telscreen  ,1 142  langlb 

1141  format T ' ♦ '  ,32x  ,f 7  21 

1 142  format ( '+ '  ,40x  ,f7  21 
c  LENGTH  OF  SECMENT  I 

wr i telscreen  ,1 1501 

1150  format ( 1 x  ,2x  , 'Length  of  Segment  l'»8x,'SI') 
write  (screen  ,1 141  Iscop la 

if  (scoplb  ne  9999  99 Iwr i te (screen  ,1 1 42 Iscoptb 
c  LINEAR  WEIGHT  OF  SEGMENT  1 
write! screen  ,1160) 

1160  format  ( 1  x  ,2x  ,  'L  mear  Weight  of  Segment  1',)x,'W1'1 
wr 1 1 e ( screen  ,  1 1 4 1  1  wo 1 1  a 

if  (wgtlb  ne  9999  99 Iwr i telscreen  ,1 142  )wgt 1b 
c  WEICHT  OF  SINKER  1 

write! screen  ,11701 

1170  format ( 1 x  ,2x  , 'Weight  of  Sinker  1',9x,'C!') 

if  (clmpl a  ne  9999  99  )wr i telscreen  ,1141  )c I mpl a 
if  (clmplb  ne  9999  99)wn telscreen  ,1 142  Iclmptb 
c  LENGTH  OF  SEGMENT  2 

wri telscreen  ,1180) 

1180  format ( 1 x  ,2x  , 'Length  of  Segment  2‘»8x,'S2'l 

if  (scop2a  ne  9999  99  Iwri telscreen  ,1 1 41  )scop2a 
if  (scop2b  ne  9999  99  Iwr i te (screen  ,1 1 42  1scop2b 
c  LINEAR  WEICHT  OF  SEGMENT  2 
wr i tel  screen  ,1 1 90 1 

1190  format  ( 1  x  ,2x  , 'L  mear  Weight  of  Segment  2',1x,'W2'l 
if  l wgt 2a  ne  9999  99  Iwr i te (screen  ,1  I  4 1  Iwg 1 2a 
if  (wgt2b  ne  9999  99  Iwr i tel  screen  ,1 1 42  )wgt 2b 

c  END 

return 

end 
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svs  f  inol/t2for/gr  m2  for## 
subrou fine  gr i n2 

Prmi  Graph  I  input  parameter  list 
implicit  integer *2  ("I 
COMMON  BLOCK  DECLARATIONS 
LUNITS 

integer*2  screen  .lievbd  ,lul  ,lu2  ,ni  v99  ,siz99  ,ncpl 

integer* 1  pre f 1 121 ) >dum1  ,ex  1 1  I #  )  ,ex  1 2 1 1 ) 
common  /lunits/  screen  ,keybd  ilul  flu2  .ni v99  ,s i *99  .ncpl  , 
A  prefl  ,duml  ,extl  ,ext2 

VAR  IN 

mteger*2  ii leg, list 
integer*^  nnca  ,nncb 
real  angla.angtb, 

A  scopla  .scoplb  ,»gt la  ,»gt lb  .clmpta  .clmplb  , 

A  scop2a  ,scop2b  ,wg  1 2a  ,«g  I  2b  ,c  I  mp2a  ,c  1  mp2b  , 

A  scop3a  ,scop3b  ,«gt  3o  ,*gi  3b  , 

A  si  ip  ,fr ic»  ,  c lmp3  , 

A  scop*  ,  »gM  . 

A  anlisep, 

A  p1x,plz,pld, 

A  p2x  ,p2z  ,p2d  , 

A  p3x  ,p3z  ,p3d  , 

A  hload.hdir, 

A  rbuov  ,xbuov  ,zbuov  , 

A  deptho  ,pdir 

common  /warm/  iileg,iisi, 

A  nnco  ,nncb  , 

A  angla.anglb, 

A  scop  I  o  iscoplb  ,«gt  la  ,«g<  lb  ,clmpla  .clmplb  , 

A  scop2a  ,scop2b  ,«gt  2a  ,«gi2b  ,clmp2a  ,clmp2b  , 

A  scop3a >scop3b  ,»g 1 3a  ,»g 1 3b  , 

A  si  ip  ,fnct  ,  c  1  mp3  , 

A  scopi  i  sgH  > 

A  anlsep > 

A  plx  ,plz  .pld  , 


ZZ8 


4  p2x  ,p2z  ,p2d  i 

A  p3x  ,p3z  ,p3d  . 

&  hload  ,hdir  , 

A  rbuoy  ixbuov  iZbuoy  , 

A  dept ho  ,pdir 

c 

c  VAROUT 

c 

real  ola  idb  iol  , 

A  oha  ,ohb  .oh  , 

A  oxla  .ox3a  ,ox5a  .oxlb  .ox3b  .oxSb  ,ox7  ,ox8  , 

A  oy  1  a  ,oy3a  ,oy5a  .oy  1  b  .oy 3b  ,oySb  ,oy 7  ,oy8  , 

A  ozla  ,oz3a  ,oz5a  .ozlb  ,oz3b  ,oz5b  .oz7  ,oz8  , 

A  oala  ,oa2a  ,oa3a  .oa^a  ,oa5a  ,oa6a  , 

A  oalb  .oa2b  ,oa3b  .oa'lb  ,oa5b  ,oa6b  .oa7  ,oa8  , 

A  ov  1  a  .ov2a  ,ov3a  ,ov1a  .ov5a  ,ov6a  . 

A  ovlb  ,ov2b  ,ov3b  .ovlb  .ovSb  .ovfib  ,ov7  ,ov8  , 

A  of  la  ,oi2a  ,oi3a  .ot4a  ,oi5a  .016a  . 

A  o  i  t  b  ,o  1 2b  ,o  i  3b  ,o  1 4b  ,o  1 5b  ,o  1 6b  .o  t  7  ,o  r  8  , 

A  odo  .oda  ,odb  , 

A  oaf  .oafdir  ,oafa  .oadir  .oafb  .obdir  , 

A  oslp  .ocoi  la  .ocoi  lb 

integer*2  oisol  .obrnch 
common  /varoui/  ola.olb.ol  . 

A  oha  ,ohb  ,oh  , 

A  oxla  .ox3a  .ox5a  .oxlb  >ox3b  ,oxSb  ,ox7  ,ox8  , 

A  oy  I  a  .oy3o  .oy5a  ,oylb  .oy3b  .oySb  ,oy7  ,oy8  , 

A  ozla  .oz3a  ,ozSa  .ozlb  .oz3b  ,oz5b  >oz7  ,oz8  , 

A  oala  .oa2a  ,oa3a  ,oa4a >oa5a  ,oa6a  . 

A  oalb  .oa2b  ,oa3b  ,oa4b  .oa5b  ,oa6b  ,oa7  ,oa8  , 

A  ov  la  .ov2a  ,ov3a  .ovfa  .ov5a  ,ov6a  . 

A  ovlb  ,ov2b  ,ov3b  .ov4b  ,ov5b  ,ov6b  .ov7  ,ov8  , 

A  oi  la  ,oi2a  ,ot3a  .oMa  ,oi5a  ,oi6a  , 

A  ol  lb  .oi2b  >ot  3b  .oMb  .ot5b  ,o»6b  .ot  7  ,o«8  , 

A  odo  .oda  .odb  , 

A  oaf  .oafdir  ,oaf a  .oadir  ,oafb  .obdir  , 

A  oslp  .ocoi la  ,ocoi lb  , 

A  oisol  .obrnch 

c 

c  VARC 

c 

doub  1  e  precision  lla.llb.il  . 

A  » ana  .  i an b  ,  t  onr  , 

r-o 

~o 
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A  xx  I  a  ,xx3o  ,xxSa  ,xx3b  >xx5b  ,xx7  ,xx8  , 

A  gall  ,gal2,ga2l  ,ga22,ga3t  >ga32 , 

A  gbl I  ,gb!2  ,gb2l  ,gb22  ,gb31  ,gb32  , 

A  gl  ,g2  , 

A  x  fa  ,x  fb  ,x  f 

common  /varg/  11  a, lib,  11  , 

A  l ana  ,tanb  ,ianr  , 

A  xxla  ,xx3a  ,xx5a  ,xx3b  ,xxSb  ,xx7  ,xx8  , 

A  gall  ,gal2,ga2l  ,ga22,ga3l  ,ga32  , 

A  gbl 1  ,gbl2,gb21  ,gb22,gb3l  ,gb32  , 

A  g  l  ,g2  , 

A  xfa  ,xfb  ,xf 

LOCAL  VARIABLES 

integer *2  i 
integer *2  gbuff(24) 
real  obmag  .xxproj 

EXECUTABLE  PORTION 

LINE  22 

WEICHT  OF  SINKER  2 
*ri tel  screen  ,110) 

110  formal (1 x  ,2x  , 'Weight  of  Sinker  2',9x,'C2'l 
if  Iclmp2a  ne  9999  99  Iwr t tel  screen  ,1 1 1  lc Imp2a 
if  (clmp2b  ne  9999  99  Iwr i te (screen  ,1 12 )c lmp2b 

111  format ('♦'  ,32x  ,f 7  2  I 

112  format t ,40x  ,f 7  21 
OCEAN  BOTTOM 
*ri te (screen  ,120) 

120  format ('+'  ,18x  ,  OCEAN  BOTTOM  ') 

OCEAN  SURFACE 
«r i te (screen  ,1301 

I  30  format ( ' ♦  '  ,83x  ,  'OCEAN  SURFACE ' I 
LINE  23 

START  LENGTH  OF  SECMENT  3 
write! screen  ,210) 

210  format 1 1 x  ,2x  , 'Star t  Length  of  Segment  3',2x,'S3') 
if  (scop3a  ne  9999  99  Iwr i te (screen  ,  M 1  )scop3a 
if  (scop3b  ne  9999  99  Iwri telscreen  ,1 12 )scop3b 
c  FLOOR  DIRECTION 

wr i telscreen  ,220  loafdtr 


230 


no  o  on  no  no  on  no 


Y2>( 


220  format t'+  '  ,50x  ,  *F loor  Direct  ion '  ,2x  ,f 7  21 
LINE  2-1 

LINEAR  WEIGHT  OF  SECMENT  3 
wr i te (screen  ,310 ) 

3t0  format ( 1 x  ,2x  , 'L inear  Weight  of  Segment  3',tx,'W3'l 

if  ( i i leg  eq  3  and  wgt3a  ne  9999  99  Iwr i te I  screen  ,t t t  Iwgt 3a 

if  (lileg  eq  3  and  wgt3b  ne  9999  99  )wr 1 1 e (screen ,1 1 2 Iwgt 3b 

if  ( i i leg  ne  3  and  wgt3a  ne  9999  99  Iwr i te (screen  ,31  I  )wgf3a 

311  format ('+  '  ,36x  , f 7  2  I 

FLOOR  SLOPE 
»ri telscreen  ,320  loaf 

320  format ('♦'  ,50x  , 'F loor  SIope',6x,f7  2) 

LOAD  DIRECTION 
*n  re  (screen  ,3301 

330  f orma t ( ' ♦ *  ,85x  ,  * Load  D i rec  1 1 on ‘  I 

if  (hdir  ne  9999  99 )»r t  telscreen  ,331 )hdir 

331  format ('♦*  ,!06x  ,f 7  21 
LINE  25 

FRICTION  COEFFICIENT 

wri telscreen  ,110 1 

110  format ( 1 x  ,2x  , 'Fr ic 1 1 on  Coef f ic lent ' 1 

if  ( fr i c  t  ne  9999  99  l»r i telscreen  ,311  I  fr ic i 
X-OEPTH-Z  HEADER 
write! screen  ,120 1 

120  format  ('♦'  ,59x  , ' - X - -Depth- - Z - 'I 

HORIZONTAL  LOAD 
wr i telscreen  ,130  I 

130  formal ('♦'  ,85x  , 'Hor i zont al  Load  H'l 

if  (hload  ne  9999  99  )wr 1 1 e (screen  ,331  Ihload 
LINE  26 

WEIGHT  OF  EQUAUZER/SPIOER  PLATE 
write!  screen  ,5 1 0 1 

510  format ( I x  ,2x  ,  'We ight  of  Equal izer/Spider  C 3 ' ) 
if  (clmp3  ne  9999  99  Iwr 1 1 e ( screen  ,31  I  )c lmp3 
POINT  PI 
i-l 

wr  i  re  ( screen  ,520  )  i  >p  1  x  ,p  1  d  ,p  1  z 
520  f  orma  t ( ’ ♦  ’  ,50x  , 'Point  P  '  ,  1 1  ,3 ( 1 x  ,  f  7  2)1 
LINE  27 

LENCTH  OF  SEGMENT  1 
wri telscreen  ,610) 

610  formot ( 1 x  ,2x  , 'Length  of  Segment  1',8x,'S1'l 
if  (scop4  ne  9999  99  Iwr i telscreen  ,31  I Iscopl 

M 
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I 
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c  POINT  P 2 

i-2 

write! screen  ,520  i  i  ,p2x  ,p2d  ,p2z 
c  PROJECTED  EXCURSION 

is-r  i  i  e  ( screen  ,630  J 

630  formal ('♦'  ,85x  , 'Projected  Excursion') 
obmag-sqr t (xbuoytxbuoy+zbuoytzbuoy ) 
xxproj-xx8 

if  (iileg  eq  I)  xxproj-obmag 
if  Ixxproj  ne  9999  99  )wr i teTscreen  ,331 Jxxproj 
LINE  28 

LINEAR  WEIGHT  OF  SEGMENT  4 
wr i te (screen  ,710 ) 

710  format ( 1 x  ,2x  , 'L inear  Weight  of  Segment  -1  W-4  '  I 
if  (wgt4  ne  9999  99  Iwr  i  telscreen  ,51 1  )wgt  4 
POINT  P3 
i-3 

write! screen  ,520  )  i  ,p3x  ,p3d  ,p3z 
LINE  29 

ANCHOR  A 

wr i t  e ( screen  ,820  1 

820  formal  1 1 x  ,50x  , ' Anchor  A  '  ) 
if  (odo  ne  9999  99 Iwr i te (screen  ,821  lox I  a  ,odo >oz 1  a 

821  format (  '  ♦  '  ,58x  ,3 ( 1 x  ,f 7  21) 

TRUE  EXCURSION 
wr 1 1 e ( screen  ,830  I 

830  format ('+' ,85x  ,' True  Excursion') 
wri te (screen  ,331 lobmag 
LINE  30 

ANCHOR  B 

write! screen  ,920 ) 

920  formal ( 1 x  ,50x  , 'Anchor  B'l 

if  (odb  ne  9999  99 Iwri tel  screen  ,821 lox 1b  ,odb  ,oz1b 
LINE  31 
ORIGIN 

write! sc reen  ,  1 020  lodo 
1 020  format  ( 1  x  ,50x  , 'Origin', 6x,'0  00  '  ,  1  x  ,  f  7  2  >4x  ,  '0  00') 
return 
end 

* 
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ei  sys  f  ir»al/t2foc/groui !  fori# 
sub rou i i ne  grou f 1 

c 

c  PRINT  VALUES  FOR  THE  UNKNOWN  INPUTS 

c 

implicit  integer*?  ("I 

c 

c  COMMON  BLOCK  DECLARATIONS 

c 

c  LUN1TS 

c 

integer*2  screen  ,keybd  ,lul  , lu2  ,ni v99  ,s i z99  ,ncp1 

integer*!  prefl  12 1  I  .dun!  ,ext  1(A)  >ext2lA  ) 
common  /lumts/  screen  ,keybd  .lul  ,lu2  ,mv99  ,siz99  ,ncpl  , 
A  prefl  ,duml  ,extl  ,ext 2 

VAR  IN 

integer*2  i i leg  >i ist 
inleger*A  nnca  ,nncb 
real  param(A0l 
real  angla.anglb, 

&  scop  1  a  ,scop  1  b  ,»g  1 1  a  >wg  1 1  b  >c  1  mp )  a  ,c  1  mp  I  b  , 

A  scop 2a  iSCop2b  ,wgr  2a  >wgt2b  ,clmp2a  ,clmp2b  , 

A  scopSa  ,scop3b  ,wg t  3a  ,wg 1 3b  ■ 

A  sIip.Tnct,  cl  mp3  , 

A  scop A  ,  wgtA  , 

A  anksep  , 

A  plx  ,plz  ,pld  i 

A  p2x  >p2z  >p2d  > 

A  p3x  ,p3z  ,p3d  , 

A  hload  ,hdir  , 

A  rbuoy >xbuoy  .zbuoy  , 

A  dep  t  ho  >pd  i  r 

common  /vorm/  iileg.iist, 

A  nnca  ,nncb  > 

A  ang 1  a  •ang I b  > 

A  scop  I  a  >scop  1  b  >«tg  1 1  a  •wg  1 1  b  >c  I  mp  I  a  >c  1  mp  I  b  , 

A  scop2a  ,scop2b  ,*g  1 2a  •wg  1 2b  .c  1  mp2a  ,c  1  mp2b  > 

A  scop3o »scop3b  ,»gt 3a  ,wgt3b , 

A  slip,fric'»  clmp3, 

A  scopA  ,  *gtA, 

A  anksep  > 
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o  o  o 


1 


i  .  M 


4  ptx  ,p1z  ,p1d  , 

4  p 2x  ,p2z  ,p2d  i 

&  p3x  ,p3z  ,p3d  , 

4  hload.hdir, 

4  rbuoy  ,xbuoy  ,zbuoy > 

4  depfho  »pdir 

equivalence  (paraml 1  I  ,angla) 
c 

c  VAROUT 

c 

real  ola  ,olb  ,ol  , 

4  aha  iOhb  ,oh  , 

4  ox  la  ,ox3a  ,ox5a  •oxlb  ,ox3b  ,ox5b  ,ox7  ,ox8  , 

4  oy  la  ,oy3a  ,oy5a  ,oy  lb  ,oy3b  ,oy5b  ,oy 7  ,oy 8  , 

4  ozla  ,oz3a  ,oz5a  ,ozlb  ,oz3b  ,ozSb  ,oz7  ,oz8  , 

4  oala  ,oa2a  ,oa3a  ,oa4a  ,oa5a  ,oa6a > 

4  oal  b  ,oa2b  ,oa3b  ,oaib  ,oa5b  ,oa6b  ,oa7  ,oa8  , 

4  ovla  ,ov2a  ,ov3a  ,ov1a  ,ov5a  ,ov6a  , 

4  ovlb  ,ov2b  ,ov3b  .ovlb  ,ov5b  ,ov6b  ,ov7  ,ov8  , 

4  of  la  ,ot2a  ,oi3o  ,of4a  ,of5a  >ot6a  , 

4  of  1b  ,of2b  ,ot3b  ,oMb  ,oi5b  ,ot6b  ,ot7  ,018  , 

4  odo  ,oda  ,odb  , 

4  oaf  ,oafdir  ,oafa  ,oodir  ,oafb  ,obdir  , 

4  os  1  p  >oco  i  I  a  iOco  i  1  b 

inieger*2  oisol  .obrnch 
common  /varoui/  ola.olb.ol  , 

4  oha  ,ohb  ,oh  , 

4  ox  la  ,ox3o  ,ox5a  ,oxlb  ,ox3b  ,ox5b  ,ox7  ,ox8  , 

4  oyla  ,oy3a  >oy5a  ,oy1b  ,oy3b  ,oy5b  ,oy7  ,oy8  , 

4  ozla  ,oz3a  ,ozSa  >oz1b  ,oz3b  >ozSb  ,oz7  ,oz8  , 

4  oala  ,oo2a  ,oa3a  ,oa4a  ,oaSa  ,oa6a  , 

4  oalb  ,oa2b  ,oa3b  ,oa1b  ,oa5b  ,oa6b  ,oa7  ,oa8  , 

4  ovla  ,ov2a  ,ov3a  ,ov1a  ,ov5a  ,ov6a  , 

4  ovlb  ,ov2b  ,ov3b  ,ovib  ,ov5b  ,ov6b  ,ov7  ,ov8  , 

4  of  la  ,ot2a  ,of3a  ,oi1a  ,oi5a  ,oi6a  , 

4  o  1 1  b  ,o  f  2b  ,o  t  3b  ,o  1 1b  ,o  1 5b  ,o  1 6b  ,o  1 7  ,o  f  8  , 

4  odo  ,oda  ,odb  > 

4  oaf  ,oafdtr  ,oafa  ,oadir  ,oafb  ,obdir  , 

4  08 1  p  ,oco  1 1  a  >oco  1 1  b  , 

4  0180 1  .obrnch 

UNKNOW 


hSZ 


fin  non  non  non 


i 


mteger*2  nonk  ,unk  1  ,unk2  ,unk3  ,unH  ,unk5 

common  /unknow/  nunk  ,unk1  ,unk2  ,unk3  ,unk4  ,unk5 

CCB 

integer*2  gbuf  f (24  I  ,  lugraf  ,  lupi f 1  , 1 udbug 
common  /get)/  gbuff  ,  lugra  f  ,  1  up  t  f )  ,1  udbug 

LOCAL  VARIABLES 

integer *2  i text  ,  ival  ,unk txt (10  1  ,unkval (40  ) 
mteger*l  ptextl26,18) 
mteger*2  three, five 

DATA  INITIALIZATION 

data  three  ,f i ve/3  ,5/ 


data  unkval/ 

4  41  ,41  ,41  ,41  ,11  ,41  ,41  ,41  ,41  ,11  , 
4  41  ,41  ,34  ,35  ,36  , 

4  41,1,3,5,7,9,11,13,15,17, 
4  41  ,  2  ,  1  ,  6  ,  8 ,10 ,12  ,14  ,16  , IB  , 
4  19  ,20  ,21  ,22  ,23/ 
data  on k  t x  t  / 

4  18,18,18,18,18,18,18,18,18,18, 
4  18  ,18  ,15,16,17  , 

4  18,1,2,3,4,5,6,7,8,9, 
4  18,  I, 2. 3, 4, 5, 6, 7, 8, 9, 


4  10,11  ,12,13,14/ 
data  p text/ 

4  'Angle  to  Bottom 
4  'Linear  Weight  of  Segment  1 
4  'Length  of  Segment  2 
4  'Weight  of  Sinker  2 
4  'Linear  Weight  of  Segment  3 
4  Fmol  Slippage  S5 
4  'Weight  of  tquol izer/Spider 
4  'Lineor  Weight  of  Segment  1 
4  'Horizontal  Lood  Magnitude 
4  'Buoy  Excursion 


, 'Length  of  Segment  l 
, 'Weight  of  Sinker  1 
, 'Linear  Weight  of  Segment 
, 'Length  of  segment  3 
» 

, "Friction  Coefficient 
, "Length  of  Segment  4 

I 

, 'Horizontal  Load  Direction 
,' INVALID  ELEMENT 


2 


EXECUTABLE  PORTION 


ssz 


U  L> 


OUTPUT 

call  chrsiz(five) 
write! screen  ,1001 
100  format ('♦', 'OUTPUT  'I 
call  chrsiz(ihree) 
c  UNKNOWN  INPUTS 

wri tel  screen  ,105) 

105  format! 1*  ,  UNKNOWN  INPUTS  'I 

if  l os 1 p  eq  9999  991  goto  210 
nunk -nunk ♦ 1 
unk3-unk2 
unk2-unk 1 
210  com  inue 

wr i r e I screen  ,140) 
c  FIRST  UNKNOWN 

if  I os  I p  eq  9999  991  go  t  o  310 
wr i tel  screen  ,1 10  )  oslp  ,ptext ( 1  ,10)  26 
goto  320 
3 1 0  con  r i nue 

1 1 ex t -unk t x t lunk 1  I 
ival  -unkval (unk 1  I 

write! screen  ,1)0)  param! i val  )  ,ptex i 1 1  , i ten t  )  26 
320  coni inue 
c  SECOND  UNKNOWN 

if  (nunk  eq  1  I  goto  900 
i text -unk  txt (un«2 ) 
ival  -unk val  (unk 2  ) 

wr i te (screen  ,120  )  param I i val )  ,pt ex t ( 1  ,i lex t  •  26 
c  THIRD  UNKNOWN 

if  (nunk  eq  2)  goto  900 
i text -unk  txt (unk 3 ) 
i val  -unkval (unk 3  I 

wn te( screen  ,130)  paramiival )  ,ptext 1 1  ,i text )  26 
900  com  inue 
return 
c  FORMATS 

1 10  format (lx  ,f7  2  ,’  -  '  ,26al I 
120  format ('♦' ,30x  ,f 7  2,'  -  '  ,26a  I  I 

130  format  ('♦'  i76x  ,f7  2,'  -  '  ,26a1  l 

I 10  format (lx) 
end 


n  n  n  n  n  n  n  n  non 


ei  sys  f mal/t2for/grout2  for#! 
subroutine  grout 2 

Print  computed  output  values  for  Graph  I 
implicit  integer*2  ("I 
COMMON  BLOCK  DECLARATIONS 
LUNITS 

mteger*2  screen  .keybd  ,lul  ,lu2  ,ni  v99  ,siz99  ,ncpl 

integer*!  pref  I  (21  I  ,duml  ,ext  1  M  )  ,ext2M  I 
common  /lunits/  screen  ,keybd  ,lu1  ,lu2  .ni  v99  ,siz99  ,ncpl  , 
A  pref  I  ,duml  ,extl  .ex  1 2 

VAROUT 

real  ola  ,olb  ,ol  , 

A  oha  .ohb  ,oh  , 

A  ox  I  a  ,ox3 a  ,ox5a  ,ox  I  b  ,ox  3b  ,ox5b  .ox  7  ,ox8  , 

A  oyla  ,oy3a  ,oy5a  ,oy  lb  ,oy3b  ,oy5b  ,oy7  ,oy8  , 

A  ozla  ,oz3a  ,oz5a  ,ozlb  >oz3b  ,oz5b  ,oz7  ,oz8  , 

A  oal a  ,oa2a  ,oa3a  ,oa4a  ,oaSo  ,oa6a , 

A  oalb  ,oa2b  ,oa3b  .oalb  ,oa5b  ,oa6b  ,oa7  ,oa8  , 

A  ovla  ,ov2a  ,ov3a  ,ov4a  ,ovSa  .ov6a  . 

A  ovlb  ,ov2b  ,ov3b  .ovlb  ,ov5b  ,ov6b  ,ov7  ,ov8  , 

A  ot  la  ,ot2o  >ot  3o  ,oHa  rotSo  >ot6a  , 

A  o t  lb  .o 1 2b  ,o f  3b  >o  Mb  ,o t Sb  ,o 1 6b  ,o 1 7  ,o 1 8  , 

A  odo  ,oda  ,odb  , 

A  oaf  .oafdir  ,oafa  .oadir  ,oafb  .obdir  , 

A  os  I  p  ,oco  1 1  a  .oco  1 1  b 
integer*2  oisol  .obrnch 
common  /varout/  ola.olb.ol  , 

A  oha  .ohb  ,oh  , 

A  ox  I  a  ,ox3a  ,ox5a  .oxlb  >ox3b  ,ox5b  >ox7  ,ox8  , 

A  oyla  ,oy 3a  ,oySa  ,oy I b  ,oy 3b  .oySb  ,oy 7  ,0"8  , 

A  ozla  ,oz3a  >oz5a  .ozlb  ,oz3b  ,oz5b  ,oz7  ,oz8  , 

A  oal  a  ,oa2a  ,oa3a  ,o aio  ,oa5a  ,oa6a  , 

A  oalb  ,oa2b  ,oo3b  >oa^b  ,oaSb  >oa6b  ,oa7  ,oa8  , 

A  ovla  ,ov2a  ,ov3a  ,ov4a  ,ovSa  ,ov6a  , 

A  ovlb  ,ov2b  ,ov3b  ,ov4b  ,ovSb  ,ov6b  ,ov7  ,ov8  , 

A  ot  la  ,ot2a  ,ot3a  ,oMa  ,otSa  ,ot6a  , 


■t 
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noon  non 


&  ot  1b  ,o)2b  ,ot3b  ,oHb  ,otSb  ,ot6b  >ot  7  ,of 8  , 

&  odo  ,od a  ,odb  , 

A  oaf  ■oafdir  ,oafa  ,oadir  ,oafb  .obdir  , 

A  oslp  ,ocoi la  ,ocoi lb > 

&  o  i  so  1  .obrnch 

LOCAL  VARIABLES 

iniegerti  juntxt (8  ,2 1  ,  tentxt ( 10  ,3 ) 
integer*2  rownml  1 1  I  ,junc  ,tenleg 
data  rownm/ 'HAVAC  LHXYZAVT  '/ 
data  juntxt/'on  floor  ',  'elevated'/ 

data  lentxi/'boih  legs  '  .'Leg  A  only'  ,'Leg  B  only'/ 

EXECUTABLE  PORTION 

PRINT  LEGEND  OF  ROWS  ,  AND  COLUMN  HEADERS 
mrnel screen  ,  1 000  1 
1000  formal  1/ 

& lx,  'HA  -  Floor  Horizontal  Angle  VA  -  Floor  Vertical  Angle',2x, 
A  'C  Chain  Coiled  on  Bottoe  L  -  Length  Along  BottomV 

Alx.'H  -  Horizontal  Force  X  -  X  Coordinate'  .I0x, 

A  ‘Y  -  Y  Coordinate  Z  -  Z  Coordinate'/ 

Alx.'A  -  Catenary  Horizontal  Angle  V  -  Vertical  Force', Bx, 

A  'T  Tension'// 

A1 x  , '  — IA--  --2A--  - - 3A - -  --4A--  --5A  --6A--', 

A  -  --18--  --28--  --3B--  --1B--  --5B--  --6B--', 

A  '  ---7 - 8---  I 

c  PRINT  HA  -  FLOOR  HORIZONTAL  ANGLE 

write!  screen  ,1011  I  rowniti  ( 1  1  ,oad  i  r 
if  (obdir  ne  9999  991  wr  i  tel  screen  ,1070  1  obdir 
c  PRINT  VA  -  FLOOR  VERTICAL  ANCLE 

wr i te (screen  ,101 1  1  rownm <2 1  .oaf a 
if  (oafb  ne  9999  99>  wri tel  screen  ,1070)  oafb 
c  PRINT  C  -  CHAIN  COILED  ON  THE  OCEAN  FLOOR 
wr i te (screen  ,10)3 )  rownml3) 

if  (ocoila  ne  9999  99)  wri tel  screen  ,1060  l  ocoilo 

if  (ocoilb  ne  9999  99)  wri relscreen  ,1 120)  ocojlb 

c  PRINT  L  -  LENCTH  ALONC  THE  OCEAN  FLOOR 
wri  te(screen  ,1012)  rownmMj.ola 
if  (olb  ne  9999  99)  wr i tetscreen  ,1070  )  olb 

if  (ol  ne  9999  991  wr»  tedcreen  ,1130)  ol 

c  PRINT  H  -  HORIZONTAL  FORCE  AT  THE  BUOY 


Z38 


I"'  I  ’  l  .. 


wri tel screen  ,1012)  roinm (5  I  ,oha 
if  (ohb  ne  9999  99)  wri telscreen ,1070)  ohb 

if  (oh  ne  9999  99)  wri telscreen  ,1 130)  oh 

c  PRINT  X  -  X  COORDINATE  OF  JUNCTION  POINT 
write! screen  ,1150) 
write! screen  , ) ) 50  ) 
wn  te (screen  ,1010)  rownwi(6 )  ,oxla 
if  (ox3a  ne  9999  99)  wn te (screen  ,1030)  ox3a 

if  (oxSa  ne  9999  99)  wr i te( screen  ,1050)  ox5a 

if  loxlb  ne  9999  99)  wr i te (screen  ,1070  I  ox  lb 

if  (ox3b  ne  9999  99)  wri te (screen  ,1090)  ox3b 

if  (ox5b  ne  9999  99)  wri tel  screen  ,1 1 10)  ox5b 

if  (ox7  ne  9999  99)  wri le (screen  ,1 130)  ox7 

if  (ox8  ne  9999  991  wr i tel  screen  ,1 110  )  ox8 

c  PRINT  Y  -  Y  COORDINATE  OF  JUNCTION  POINT 

if  (ox8  eq  9999  99)  wri telscreen  ,1150) 
wr i telscreen  ,1010 )  rownm(7 )  ,oy la 
if  (oy3a  ne  9999  99)  wr i te ( screen  ,1030 )  oy3a 
if  (oy5a  ne  9999  99)  wr i te (screen  ,  1050 )  oy5a 

if  toy  1b  ne  9999  99)  wr 1 1 e (screen  ,1 070  )  oylb 

if  (oy3b  ne  9999  99  I  wri telscreen  ,1090)  oy3b 

if  (oySb  ne  9999  99)  wri telscreen  ,1  I  10)  oy5b 

if  (oy7  ne  9999  991  wr i telscreen  ,  1 1 30  I  oy7 

if  (oy8  ne  9999  991  wr  i  te  ( screen  ,1  M0  I  oy8 

c  PRINT  Z  -  Z  COORDINATE  OF  JUNCTION  POINT 

if  (oy8  eq  9999  99!  wr i te ( screen  ,1 1 50  I 
wri telscreen  ,1010  I  rownmlS  I  >oz1a 
if  (oz3a  ne  9999  99)  wr i te ( screen  ,1030  )  oz3a 

if  (ozSa  ne  9999  99  I  wri telscreen  ,1050)  oz5a 

if  lozlb  ne  9999  991  wr i te ( screen  ,1070  )  ozlb 

if  (oz3b  ne  9999  99)  wr i te (screen  ,1090  I  oz3b 

if  (oz5b  ne  9999  99)  wri telscreen  ,1 1 10)  oz5b 
if  (oz7  ne  9999  99)  wr i te (screen  ,1 1 30 >  oz7 

if  (oz8  ne  9999  99)  wri  telscreen  ,1  M0)  oz8 

c  PRINT  A  -  ANCLE  TO  THE  HORIZONTAL 

if  (oz8  eq  9999  99  I  wr i te ( screen  ,1 1 50  ) 
wr i telscreen  ,1 150  I 
wr i telscreen  ,1010 )  ro»n»(9)  ,oata 
if  (o a2a  ne  9999  99)  wri telscreen  ,1020)  oa2a 

if  (oo3e  ne  9999  99)  wri telscreen  ,1030 )  oo3a 

if  (oo46  ne  9999  991  wr i telscreen  ,1040 )  oala 

if  (oe5e  ne  9999  99)  wri telscreen  ,1050 )  oa5a 

if  (oaOe  ne  9999  99)  wri telscreen  ,1060)  oa6a 


bSZ 


A 


i  r 

loalb 

ne 

9999 

99) 

wr  i 

te (screen  ,1070) 

oalb 

i  r 

(oa2b 

ne 

9999 

99) 

wr  i 

te (screen  ,1080) 

oa2b 

i  f 

(oa3b 

ne 

9999 

99) 

wr  i 

te (screen  ,1090) 

oa3b 

i  r 

loa4b 

ne 

9999 

99) 

wr  i 

tel  screen  ,1100) 

oa4b 

i  f 

(oaSb 

ne 

9999 

99) 

wr  i 

telscreen  ,1110) 

oaSb 

i  f 

loa6b 

ne 

9999 

99) 

wr  i 

telscreen  ,1120) 

oa6b 

i  r 

(oa7 

ne 

9999 

99) 

wr  i 

telscreen  ,11301 

oa7 

i  f 

(oa8 

ne 

9999 

99) 

wr  i 

telscreen  ,1140) 

008 

PRINT  V 

-  VERTICAL  FORCE 

if 

(oa8 

eq 

9999  99 

)  wr 

i telscreen  ,1150) 

»ri t  e ( screen  ,1010)  rownm 

(101  ,ovla 

i  r 

(ov2a 

ne 

9999 

99) 

wr  i 

telscreen  ,1020) 

ov2a 

i  f 

(ov3a 

ne 

9999 

99) 

wr  i 

telscreen  ,1030 ) 

ov3a 

i  f 

(ov4a 

ne 

9999 

99) 

wr  i 

telscreen  ,1040) 

ov4a 

i  f 

<0v5a 

ne 

9999 

991 

wr  i 

telscreen  ,1050) 

ov5a 

i  f 

(ov6o 

ne 

9999 

99) 

wr  i 

telscreen  ,1060) 

ov6o 

i  f 

(ovlb 

ne 

9999 

99) 

wr  i 

telscreen  ,1070) 

ov  l  b 

i  f 

lov2b 

ne 

9999 

99) 

wr  i 

telscreen  ,1080) 

ov2b 

i  f 

(ov3b 

ne 

9999 

99) 

wr  i 

telscreen  ,1090) 

ov3b 

i  f 

tov4b 

ne 

9999 

991 

wr  i 

telscreen  ,1100) 

Ov4b 

i  f 

(ovSb 

ne 

9999 

991 

wr  i 

telscreen ,1110) 

ov5b 

i  f 

<ov6b 

ne 

9999 

99) 

wr  i 

telscreen  ,1120) 

ov6b 

i  f 

<ov7 

ne 

9999 

99) 

wr  i 

tel  screen  ,1 130) 

ov7 

i  f 

Iov8 

ne 

9999 

99) 

wr » 

telscreen  ,1140) 

ov8 

PRINT  T 

-  TENSION 

i  f 

(ov8 

eq 

9999  99 

wr 

i telscreen  ,1 150  i 

wr i te (screen  ,1010 )  rownm 

( 1 1  1  ,ot  la 

i  r 

<oi2o 

ne 

9999 

991 

wr  i 

telscreen  ,1020  I 

ot2o 

i  r 

lot  3a 

ne 

9999 

99) 

wr  i 

telscreen  ,1030  ) 

ot  3a 

■  r 

lot4a 

ne 

9999 

99) 

wr  i 

telscreen  ,1040 ) 

ot  4a 

t  f 

lot5e 

ne 

9999 

991 

wr  i 

telscreen  ,1050) 

ot5a 

i  f 

(o«6a 

ne 

9999 

99) 

wr  t 

telscreen  ,1060) 

ot6a 

i  f 

lot  Jb 

ne 

9999 

991 

wr  i 

tel  screen  ,1070 ) 

o  1 1  b 

i  f 

lot2b 

ne 

9999 

991 

wr  i 

tel  screen  ,1080 ) 

ot2b 

i  f 

lot  3b 

ne 

9999 

99) 

wr  i 

telscreen  ,1090 ) 

ot  3b 

i  r 

lot  4b 

ne 

9999 

991 

wr  i 

telscreen  ,1 100) 

Of  4b 

i  r 

Cot  5b 

ne 

9999 

99) 

wr  i 

telscreen  ,1 1 10) 

ot5b 

i  r 

CotOb 

ne 

9999 

99) 

wr  j 

telscreen  ,1120) 

ot  6b 

.  f 

Cot  7 

ne 

9999 

99) 

wr  i 

telscreen  ,1 1 30  l 

ot  7 

i  r 

lots 

ne 

9999 

99) 

wr  i 

telscreen  ,11 40 ) 

o  t8 

ii  iuid  »n  w  i  wi  i  mistreiin  ,mvi 

c  PRINT  SOLUTION  TYPE  USEO  FOR  COMPOUND  LEC 

i f  lot  8  eq  9999  991  »ri tel  screen  ,1150) 
junc  -  lotsol+1 )  /  2 


! 


Z4Q 


lent eg  -  obrnch  +  I 

if  (ox  1b  ne  9999  991  wri  tel  screen  ,1  160  I  juntxtll  ,junc  )  8> 


&  t entx i ( I  , renleg  I  10 
re i urn 

1010  formal (  '♦  '  .a I  ,f8  21 
101  I  format ( lx  ,a2  ,f7  21 

1012  format(lx,a1  ,f8  21 

1013  format ( 1 x ,a1  1 

1 020  f  orma I C ' ♦ ' >  9x  ,  f 8  21 
1030  formal ('♦'  .1 7x  ,f8  21 
1 010  f  orma l (  '  ♦  '  >25x  ,  f 8  2  I 
1050  formal ( ,33x  ,f8  2) 

1 060  formal  (  ' ♦  '  ,1 1  x  ,f8  21 
1070  format ( '♦ '  .19x  ,f8  2  I 
1080  format  I  '  t57x  tf8  2  I 
1090  formal (  ’♦  '  .65x  ,f8  2  I 
1 100  formal (  ,73x  ,f8  21 

1110  formal ( ' ♦  '  .8 lx  ,f8  21 
I  1 20  formal  1  '  +  '  !89x  , f8  21 
I  130  formal (  '♦  '  ,98x  ,f8  2) 

1110  format ('♦'  iI06x  ,f8  2) 

1  1 50  formal (lx) 

1160  formal ( 1 x  , 'Sol ul ion  Type 
&  1 0a  I  I 


Junction  '  ,8a 1  >'  ,  tension  on 


oou  ouu  ouu  uuu  uo 


ei  sys  f maI/t2for/graphs  fori  I 
subroutine  graphs (is*) 
implicit  mteger*2  («l 

c 

c  Produce  annotated  symbolic  depiction  of  compound  leg,  tables  of 
c  parameters  input  to  define  it  ,  and  tables  of  computed  forces, 
c  coordinates,  angles  and  tensions 
c 

c  parameter 

c 

integer*2  is* 

c  COMMON  BLOCK  DECLARATIONS 

c 

c  TITLES 

c 

integer*!  ctitle(IM) 

common  /titles/  ctitle 

DATIME 

i n  t  eger  *  I  cda  t i m ( 1 6  I 

common  /dot ime/  cdat im 

VARIN 

integer*!  cvarm(l72) 

common  /vann/  cvarm 

VAROUT 

integer* !  cvaro ) (240  I  ,cvaro2 ( 1 00  I 

common  /var out/  cvaro!  ,  cvoro2 

VARG 

integer*!  cvorg(2401 

common  /var g/  cvarg 

UNKNOW 


non  non  non 


\ 


integer*!  cunknoCI2) 

common  /unkno*/  cunkno 

CROPT 

integer*!  cgropt(44) 

common  /gropf/  cgropt 

CRP2CN 

integer*!  cgrp2 ! (21 8  )  ,cgrp22 182  ) 

common  /grp2cn/  cgrp21  ,  cgrp22 

LOCAL 

integer *2  funkey 

c  EXECUTABLE  PORTION 

c 

c  PRINT  TABLES  OF  INPUT  PARAMETERS,  COMPUTED  VALUES  AND  STICK  FIGURE 
call  RUC0M1 ( I  ) 
i  s»- 1 

cal  1  stick 

50  call  T lush i 

call  readfk ( funkey  1 

*  t f ( funkey  NE  -32768)  go  to  !00 
CALL  ERASE 

*  WRITE (6  ,9000) 

9000  FORMAT!/////////////,'  ',! 5X  , 'PROCESS ING  AT  THIS  POINT  MAY  TAKE 

A,  ■15  SECONDS  PLEASE  BE  PATIENT*') 

GO  TO  300 

) 00  iflfunkey  eq  18384)  go  to  200 
go  to  50 

200  tsw-2 

300  com  mue 

cal  1  RWC0M1 (2) 

return 

end 


tvz 


on  n  non  non  non  non  non 
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ei  sys  f inel/t2for/st ick  forM 
SUBROUTINE  STICK 

THIS  ROUTINE  WILL  PUT  OUT  THE  STICK  FIGURE  ON  THE  FIRST  GRAPHIC  SCREEN 

IMPLICIT  INTECER*2  (A-Z,«l 
INTECER*2  ISW 
INTEGER  MINUS,  PLUS 
REAL  THETA  .SCALE 

CCB 

imeger*2  gbuf  f  (21  I  .lugraf  ,lupt  f  1  ,1  udbug 
common  /gcb/  gbuff, lugraf  ,  1  up t f 1  , 1 udbug 
DATA  MINUS/'-'/,  PLUS/  '♦'/ 


cal  I  gf  mi  i 

CALL  VIEWPTI-I 1S0  ,32766  ,6981  ,193161 
CALL  W I NOOU ( -  1 200  ,32767  ,6900 ,191001 

INITIALIZATION  OONE  ,  SET  OUT  FICURE 

ISU-0 

THETA  -  0  0 
SCALE  -  75  0 

DRAW  THE  BOUNDARY  LINES 

CALL  MOVETO ( -  1 1 19  ,6985) 

CALL  DRAWTO (32765  ,6985  ) 

CALL  ORAWTO(32765  ,193151 
CALL  DRAWTO ( - 1 119  ,19315  I 
CALL  ORAWTOI-I  M9  ,6985) 

SET  THE  LOWER  LEFT  ANCHOR  AND  START  ORAWING  FIGURES 

CALL  MOVE TO (100 ,10500 1 
CALL  ANCHOR (THETA  .SCALE  . ISW 1 
CALL  DR AW (8000,0) 

CALL  SINKERtTHETA  .SCALE  , ISW) 

CALL  DR AW (8000,0) 


tvz 


(-)  on 


/  is 


CALL  SINKER(TH£TA  .SCALE  ,ISW> 

CALL  DRAW (8000  ,0  I 
CALL  DASH (0  ,1600) 

CALL  DRAW ( -8000  ,0  ) 

CALL  SINKER l THETA  .SCALE  . I SW ) 

CALL  DRAW ( -8000  ,0  ) 

CALL  S1NKER(THETA  .SCALE  . I SW  I 
CALL  DRAW ( -8000  ,0 ) 

CALL  ANCHOR ( THETA  .SCALE  , I SW  I 
CALL  MOVE (24000  ,-2300  1 
CALL  ELIZERITHETA  .SCALE  ,ISW) 

CALL  DRAW (6500,0) 

CALL  BUOY ( THETA  .SCALE  .1SW  I 

END  OF  PICTURE  .  NOW  TITLE  AND  BE  OONE 

CALL  MOVE TO  I- 1000  ,7200) 

WRITE (LUGRAF  ,10001 

1000  FORMAT!'  '  ,20X ,  BRANCH  B'  I 
CALL  MOVE  TO (-1000 >10600) 

WRI TE ILUCRAF  .1001 ) 

1001  FORMAT!'  '  ,3X  , '  1  '  ,1  1  X  ,  2  3',11X,'4  5',1!X,  6  I 
CALL  MOVE  TO! -1000  ,15200  I 

WRI TE (LUGRAF  ,1001 1 
CALL  MOVE  TO ( -  1 000  >  M  1 50  I 
WRITE (LUCRAF  ,1002  1  MINUS 

1002  FORMAT ('  ',6X,'S1  W1  Cl  S2W2  C2  S3 '  ,A 1  ,  'SS  W3 '  > 
CALL  MOVETO!- 1000  ,95501 

WR I TE! LUCRAF  ,1002  )  PLUS 
CALL  MOVETO! -1 000 ,18500) 

WRITE (LUGRAF  ,1003) 

1003  FORMAT ( ’  '  ,20X  ,  BRANCH  A '  1 
CALL  MOVE  TO (25900  ,18500  I 
WRITE (LUCRAF  ,I00A  ) 

100-1  FORMAT!'  ',  COMMON  ) 

CALL  MOVE TO (25900  ,17600  I 
WRITE (LUCRAF  ,1007  ) 

1007  FORMAT!'  '.'SECTION') 

CALL  MOVE TO (2*800  ,12950 > 

WRITE (LUCRAF  ,10051 
1005  FORMAT! '  '  , ' 7 '  ,8X  ,  '8 ' 1 

CALL  MOVETO12A800  ,120501 
WRITE (LUCRAF  ,1006) 


SYZ 
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ei  svs  f  mal/i2for/sinlier  forH 

SUBROUTINE  SINKER1THETA  .SCALE  ,ISWI 

THIS  ROUTINE  WILL  DRAW  AN  SINKER  SYMBOL  ON  THE  SCREEN  AT  THE  POINT  X  ,Y 
THE  ORIENTATION  OF  THE  SYMBOL  WILL  BE  ABOUT  THE  ANCLE  THETA  (MEASURED  CLOCKWISE) 

THE  SCALE  FACTOR  WILL  EITHER  SHRINK  OR  EXAGGERATE  THE  SYMBOL  WITH  1  0  BEING  THE  NORM 

THE  SYMBOL  IS  CENTEREO  ON  THE  POINT  X  ,Y 

IMPLICIT  REAL  (A-Z) 

INTEGER*2  I  ,IX  .1 Y  ,IXSV  ,IYSV  ,ISW  ,JSW 
DIMENSION  XPNTm.YPNTMl 
DIMENSION  XPOINT  M  )  ,  YPOINTm 
COMMON  /GROPT/UXL  ,WXU  ,WYL  ,WYU 
OATA  XPOINT/  00,25,  -50,25/ 

DATA  YPOINT/  3  5,-7  0,0  0,7  0/ 

DATA  DEL VX/61000  /  ,  OELVY/18000  / 

DATA  XPNT/0  0,280  5,-561  0,280  5/ 

DATA  YPNT/121  0,-812  0,0  0,812  0/ 

CHECK  IS  THE  SCALE  VALUE  LESS  THAN  ZERO,  YES  RETURN 

IF  (SCALE  LE  0  0)  GO  TO  1000 

SAVE  THE  ORIGINAL  VALUES  OF  THE  INPUTS  AND  DRAW  SYMBOL 

JSW-ISW+1 

xsc-scale 

IF ( JSW  EQ  2)  XSC-1  0 
CT-1  0 
ST-0  0 

IF  (THETA  EQ  0  0)  GO  TO  100 
CT  -  COS(THETAI 
ST  -  SINITHETAI 
100  CONTINUE 
DO  200  1-1  ,1 

XP-XPOINT ( I ) 

YP-YPOINT ( I ) 

IF (JSW  EQ  1)  GO  TO  125 
DELWX-WXU-WXL 
DELWY-WYU-WYL 
XP-(XPNT( I  ItOELWX l/DELVX 
YP- (YPNT ( I ItOELWY l/DELVY 


LVZ 


nnn  non  nnxmnn 


et  sys  f inal/»2for/onchor  forM 

SUBROUTINE  ANCHOR! THETA  .SCALE ,1SU ) 

THIS  ROUTINE  WILL  DRAW  AN  ANCHOR  SYMBOL  IX)  ON  THE  SCREEN  AT  THE  POINT  X  ,Y 
THE  ORIENTATION  OF  THE  ANCHOR  WILL  BE  ABOUT  THE  ANCLE  THETA  IMEASURED  CLOCKWISE  I 
THE  SCALE  FACTOR  WILL  EITHER  SHRINK  OR  EXACCERATE  THE  ANCHOR  WITH  1  0  BEING  THE  NORM 

THE  SYMBOL  IS  CENTERED  ON  THE  POINT  X  ,Y 

IMPLICIT  REAL  (A-Zl 
INTECER*2  I  ,IX  , I Y  ,ISW  ,JSV 
DIMENSION  XPOINT  Ml,  YPOINT(I) 

DIMENSION  XPNTMI.YPNTM) 

COMMON  / CROPT/UXL  ,WXU ,WYL ,VYU 
DATA  DELVX/61000  /  ,  OELVY/18000  / 

DATA  XPNT/280  S  ,280  S  ,-280  5  ,-280  5/ 

DATA  YPNT/121  0,-121  0,-121  0,121  0/ 

DATA  XPOINT/  2  S  .  2  5  ,  -2  5  ,  -2  5/ 

DATA  YPO I  NT /  3  5,-3  5,-3  5,3  5/ 

CHECK  IS  THE  SCALE  VALUE  LESS  THAN  ZERO,  YES  RETURN 

IF  (SCALE  LE  0  0)  CO  TO  500 

SAVE  THE  ORIGINAL  VALUES  OF  THE  INPUTS  AND  DRAW  SYMBOL 

JSW-ISW+1 
XSC-SCALE 

IF ( JSW  EQ  2)  XSC-1  0 
CT-1  0 
ST-0  0 

IF  (THETA  EQ  0  0)  GO  TO  100 
CT  -  COS (THETA  I 
ST  -  SIN(THETA) 

100  CONTINUE 

DO  200  1-1  ,1 
XP-XPOINT ( I  1 
YP-YPOINTU  1 
IF (JSW  EQ  I  I  CO  TO  125 
DELWX-WXU-WXL 
OELWY-WYU-WYL 
XP- ( XPNT ( I  1YDELWX  l/DELVX 
YP- ( YPNT ( I UOELWY  l/DELVY 


b+z 
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ei  sy s  f inel/i2for/el izt  To rll 

SUBROUTINE  ELlZER(THETA  .SCALE  ,ISM I 

THIS  ROUTINE  MILL  ORAM  AN  EL1ZER  SYMBOL  ON  THE  SCREEN  AT  THE  POINT  X  ,Y 
THE  ORIENTATION  OF  THE  SYMBOL  MILL  BE  ABOUT  THE  ANCLE  THETA  IMEASUREO  CLOCKWISE) 

THE  SCALE  FACTOR  MILL  EITHER  SHRINK.  OR  EXAGGERATE  THE  SYMBOL  MITH  1  0  BEING  THE  NORM 

THE  SYM80L  IS  CENTEREO  ON  THE  POINT  X  ,Y 

IMPLICIT  REAL  (A-Z) 

1NTEGER*2  I  .IX  ,IY  ,IXSV  ,IYSV  ,ISM  ,JSW 
01  MENS  I  ON  XP0INTM1,  YP01NTI4) 

DIMENSION  XPNT(4  I  ,YPNT  M  I 
COMMON  /CROPT/WXL  ,MXU  ,MYL  ,UYU 
DATA  OELVX/64000  /  ,  OELVY/48000  / 

DATA  XPNT/S61  0,-561  0,0  0  ,S6l  0/ 

OATA  YPNT/0  0,-421  0,842  0,-421  0/ 

DATA  XPOINT/  S  0,  -5  0,0  0,5  0/ 

OATA  YPOINT/  0  0.-3  5,  7  0,  -3  5/ 

CHECK  IS  THE  SCALE  VALUE  LESS  THAN  ZERO,  YES  RETURN 

IF  (SCALE  LE  0  01  CO  TO  1000 

SAVE  THE  ORIGINAL  VALUES  OF  THE  INPUTS  ANO  DRAW  SYMBOL 

JSM-ISWtl 
XSC-SCALE 

IF ( JSM  EQ  21  XSC-1  0 
CT-1  0 

ST-0  0 

IF  (THETA  EQ  0  0 1  GO  TO  100 
CT  -  COS (THETA  I 
ST  -  SIN1THETAI 
100  CONTINUE 
DO  200  l-l  ,4 

XP-XPOINT ( I  I 
YP-YPOINTtI  ) 

IF (JSM  EQ  I  )  CO  TO  12S 
DELVX-WXU-WXL 
OELWY-WYU-WYL 
XP-IXPNTI I ltDELWX l/DELVX 
YP- i YPNT ( I 1KDELWY l/DELVY 


non  non  no  > oono 


ei  svs  f inal/i2for/buoy  fo rfi 

SUBROUTINE  BUOY (THETA  .SCALE  , I SW I 

THIS  routine  will  draw  an  buoy  symbol  on  the  SCREEN  AT  THE  POINT  X  ,Y 
THE  ORIENTATION  OF  THE  SYMBOL  WILL  BE  ABOUT  THE  ANCLE  THETA  (MEASURED  CLOCKWISE  I 
THE  SCALE  FACTOR  WILL  EITHER  SHRINK  OR  EXAGGERATE  THE  SYMBOL  WITH  1  0  BEING  THE  NORM 

THE  SYMBOL  IS  CENTERED  ON  THE  POINT  X  ,Y 

IMPLICIT  REAL  (A-ZI 
INTEGER*2  I  ,IX  , I Y  ,!XSV  ,IYSV  .ISW  ,JSW 
DIMENSION  XPOINT (5 )  ,  YPOINT(S) 

0 1 MENS  I ON  XPNT (S  I  .YPNT (S  I 
COMMON  /GROPT/WXL  ,WXU  ,WYL  .WYU 
DATA  XP01NT/2  5.00,  -5  0,00,5  0/ 

DATA  YPOINT/  3  5,-7  0,0  0,7  0,00/ 

DATA  DELVX/64000  /  ,  DELVY/18000  / 

DATA  XPNT/280  5,0  0,-561  0,0  0,561  0/ 

DATA  YPNT/A2I  0  .-8A2  0  ,0  0  ,8A2  0  ,0  0/ 

CHECK  IS  THE  SCALE  value  LESS  THAN  ZERO,  YES  RETURN 

IF  (SCALE  LE  0  0)  GO  TO  1000 

SAVE  THE  ORIGINAL  VALUES  OF  THE  INPUTS  AND  DRAW  SYMBOL 

JSW-ISW+1 
XSC-SCALE 

IFlJSW  EQ  21  XSC-1  0 
CT-1  0 

ST  *0  0 

IF  (THETA  EQ  0  0)  GO  TO  100 
CT  -  COS l THETA  I 
ST  .  SIN(THETA) 

(00  CONTINUE 
DO  200  1-1  ,5 

XP-XPOINTI l I 
YP-YPOINTI 1  I 
IF ( JSW  EQ  11  GO  TO  125 
DELWX-WXU-WXL 

delwy-wyu-wyl 

XP-IXPNTI I  )*OELWX 1/OcLVX 
YP-(YPNT ( I XOELWY 1/DELVY 
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el  svs  f  inal/t2for/el vpnt  forH 

subrout  me  EL  VPNT  (  iov  »i  1 1  1  >i  sw  ) 

************************************************************************ 
implicit  integer*2  (•»  I 
implicit  double  precision  (a-zl 

integer *2  iov  ,i f 1  I  ,isw 

integer*2  screen  ,heybd  ,lul  ,lu2  ,ni v99  ,siz99  ,ncpl 
integer*  I  pref  I  121)  ,duml  ,ex  tl  Ml  ,ex  t2M)  ,ex  1 3  ( 1  ) 
common  /LUNITS/  screen  ,heybd  ilul  ,lu2 >ni v99  ,s i z99  ,ncpl  , 

4  pref)  ,duml  ,extl  ,ext2iext3 

inteaer*2  ileg.ist  ,nca  ,ncb  ,n»a  ,n«b  .isol  , ibrnch  ,uz  15  ) 
double  precision  z  (67  I  ,cz  ,cx  ,d  ,ta  ,tb 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  .Z  ,CZ  ,cx  ,d  ,ta  ,tb  ,n»o  ,n»b  , 

4  i sol  , i brnch  ,uz 
double  precision  za(2S  I  ,zb(25 I 
equivalence  Izl 1  )  ,za( I  )  )  ,  lz(26  I  >zb( 1  I  ) 

double  precision  ha  .ala  ,va  (sla  ,*la  ,cla  ,s2a  ,«*2a  ,c2o  »s3a  ,*3a  , 

&  xa  •va  ,xta  ,x2a  ,x3a  ,y  I  a  >y2a  ,y3a  . 

4  t  ana2a  ,  t  ana3a  ,  t  ana^a  ,  t  anaSa  ,  t  ana6a  ,  l a  .ph i a 
equivalence  ( za( t  l  ,ha  )  ,  ( za (2  )  ,al a  ,va  )  » 

4  ( za  ( 3  l  .s  l  a  l  ,  ( za  M  I  ,« 1  a  )  .  ( za  ( 5  )  .c  I  a )  , 

4  I za 16  )  ,s2a  I  ■  ( za( 7  I  ,«2a  I  ,  ( za ( 8  )  ,c2a  )  , 

4  ( za<9  l  ,s3a  I  ,  ( za  1 10  I  ,w3a  )  ,  ( zat  l  I  I  .xa  I  ,  ( z a  1 1 2  t  ,va  )  . 

4  ( za ( 1 3  I  ,x I  a  1  ,  t  za ( M  1  ,x2a  )  ,  (zal 15 )  ,x3a )  ■ 

4  (zal  16  )  .y  la  I  .  I  zal  I  7  I  ,y2a  l  .( zal  1 8  I  .y3a  )  , 

4  (zal 19)  ,tana2o )  . ( zal 20 )  it ana3a )  , ( zal 2 1  >  ,t  ana*a  i  , 

4  I zal 22 1  1 1 anaSa  )  •  I zal 23  )  ■  iqna6a I  , (za 12*  )  ,1a)  , t za 1 25 )  ,phia I 
double  precision  hb  ,alb  ,vb  ,slb  ,wlb  ,clb  ,s2b  ,w2b  ,c2b  ,s3b  ,w3b  i 
4  xb  ,vb  >xlb  >x2b  ,x3b  ,y1b  >v2b  ,y3b  ■ 

4  t  ana2b  ,  t  ana3b  ,  t  ana4b  ,  t  ana5b  ,  t  ana6b  ,  I b  ,ph i b 
equ i va 1 ence  I  zb (I  1  ,hb  I  ,  I  zb  1 2 )  ,a ' b  ,  vb  )  , 

4  I  zb  (31  .sib )  »<zbM  I  ,wlb  I  ,  (zb(S I  ,clb  l  • 

4  I  zb  (6  I  ,»2b  )  ,  Izbl  7  I  ,«2b)  ,(zbl8l  ,c2b)  , 

4  ( zb (8)  ,s3b  I  , Izbl  101  ,«3b)  ,  I  zb (  U  I  ,xb  I  ,  I  zb 1 1 2  t  ,yb  I  , 

4  Izbl  I  3 1  .xlb I  ,  Izbl 14  I  ,x2b  I  ,  I  zb ( 15)  ,x3b  )  , 

4  (Zb  116  )  ,y  lb  I  , Izbl  I  7  1  )V2b  I  ,  (zb  118)  ,y3b)  . 

4  Izbl 181  ,tana2b)  , izbl 20  I  ,tana3bl  , (zb(2l  )  , lanaibl  , 

4  ( zb  1 22 1  .  tana5b  )  ,  (zb (23  I  ,  tana6b I  .  ( zb  1 24  I  ,1b)  .  I  zb (25 )  ,phib) 

double  precision  coi  1  ,slp  ,frct  ,c3  ,s*  ,x*  ,y4  ,tana7  , tana8  >1  , 

4  h,phiK,rtot  ,xtot  ,ztot  ,do 


1 


/ 


if) 


equivalence  (z (SI  I  ,coi I  I  ,  (z (S2 1  .sip)  ,  (z (53  )  ,  frc  r )  ,  (z (51 1  ,c3 )  i 
4  (z(5S )  ,s3  )  ,  (z(56 )  ,«3  J  ,(z(S7 )  ,x3  )  , (z(S8  I  ,y3  )  , 

&  (z(S9)  ,tana7l  ,  (z(60)  , iana8)  i(z(6t  )  .  1  )  > 

4  ( z  ( 62  I  >h  I  ,  (z  (63  I  .phihl  , 

4  ( z  (63  )  ,noi  )  ,  ( z (65 1  ,x  tot  I  ,  ( z  166  )  .Z  to i  )  .  ( z  1 67  )  ,do  ) 

mleger«2  nc(2l 
equ i va l ence  ( nca  ,nc  I 
double  precision  tx(2) 
equivalence  (ta.txl 

double  precision  pi  .halfpt  .degrad  .raddeg  .zero  .one  ,half 
integer*2  i zero  ,  i one  ,  i t »0 

common  /VCONST/  pi  ,hal fpi  .degrad  iraddeg  .zero  .one  ,hol f  . 

4  i zero  ,ione  , i two 

double  precision  rnaf  ,phif 
common  /VOFLR/  tnaf  ,ph i ( 

double  precision  de  1  y  k  ,  f  wod  .ha  1  fd  ,dsq 
common  /VANCH/  delyk  , t mod  ,hal f d  ,dsq 

i n  t  eger  »l  1 1  1 1  e  <  50  )  ,  i  f  i  1 «?  ( 32  I  ,o  f  1 1  e  ( 32  ) 
common  /TITLES/  t i t 1 e  ,  i f i 1 e  .o f i 1 e 
integer»2  i2f i le( 16  I  ,o2f i let  16  1 
equ i va I ence  (ifile.i2fi!el.(ofile  ,o2  file) 

in  t eger *2  i date (S  )  .  ihour  ,  im in  , i sec 
common  /DAT! ME/  i da f e  .  i hour  ,  i mi n  ,  i sec 

'teger*  I  cvarm(l72) 
common  /VAR IN/  cvorm 

in  teger 1 1  cvarol (230  1  .cvaro2 (100) 
common  /VAROUT/  cvarol  ,cvaro2 

double  precision  ddum1(l3). 

4  gall  >ga!2  .ga2l  ,g a22  ,ga3l  ,g oZ2  , 

4  gbl  I  >gb!2  ,ab2'  .gb22  ,gb3t  ,gb32  , 

4  gl  >g2  .ddumZ 1 3 l 
common  /VARC/  dduml 
4  gal  1  .gal 2  ,ga2t  >gaz2  .ga3l  ,ga32  . 

4  gbit  .gbl2  .gb2i  >gb22  ,gb3l  >gb32  . 

4  gl  >g 2  ,ddu m2 


9  SZ 


..  .-7 


double  precision  gcff(12) 
equivalence  (gall  ,gcff) 

integer*!  cunkno(!2l 
common  /UNKNOW/  cun k no 

integer*!  cgroptMl) 
common  /CROPT/  cgropt 

integer*!  cgrp2l (21 8  1  ,cgrp22 (82 ) 
common  /GRP2CN/  cgrp2l  ,cgrp22 

double  prec i s ion  cosdp  ,xk  ty  k  ixg  ,yg  >qx  1  >gx2  ,1  x  ,segl  en  ,xm  in  ,ymin  , 

A  xmax  ,ssum0  ,ssum!  ,xsum0  ,xsum1  ,ysum0  ,ysum1 
real  xout  ,yout 

i  n  t  eger*2  i  sym  ,npt  ,ib  ,ncx  ,  i  of  f  ,  ic  .ix  ,iy  ,is  >ncomp  .npo  m  t  I S  ) 
common  /VEL VPT /cosdp  ,xk  ,y k  ,xg  ,yg  ,gx I  >gx2  ,  1  x  ,seglen  ,xmin  ,ymin  , 

A  xmax  ,ssum0  ,ssum!  ,xsum0  ,xsuml  ,ysum0  ,ysuml  ,*oui  ,yDu!  . 

A  i  sym  ,np  t  ,ib  ,nc«  ,  lof  f  ,ic  iix  ,iy  ,is  ,ncomp  ,npo  i  n  i 

integer*2  nbr  ,ibc  ,icjrv  ,ibent  ,ip  , 

A  tend  liver  t  ,i  Is  >ig  >igtyp  ,i  ,j  ,n  ,igc 
douh 1 e  precision  x  f ( 2  i2  I  .y  f ( 2  i2  1 

integer*!  ansi!  1  iyes 
data  yes/  '  Y  '  / 

************************************************************************ 

*  BEGIN  EXECUTABLE  code 

************************************************************************ 
if  1 1 f  1 1  eq  1  )  goto  30 

wr i t e (screen  ,*  )  'Do  you  want  to  save  output  for  elevation  views7' 
read ( keybd  i*  I  ans 
if  (ansi  I)  eq  yes  I  goto  20 
isw-l 

goto  9000 
20  cont inue 

wr i re (screen  ,* I  'Enter  segment  increment  length  (fee')  ’ 
read! keybd  i* )  seglen 
cal  1  RWCOM 1 ( I  l 
goto  100 

30  cont inue 

if  (isw  eq  I)  goto  9000 


LSZ 


if  l i ov  eq  II  go i o  50 
call  ADOE X T ( i f 1 1 e . 3 1  ,ext3l 
cal  1  f  t  leh2f  i  le  ,lul  ,3) 
goto  SS 
50  cont inue 

call  AODEXT (of i le  ,31  .ex t 3  I 
call  f i le (o2f i le  ,  lul  ,3  I 
55  com  inue 
igt yp-2 

wr  i  re ( lul  .1 1  igt  yp 

wr i tel lul  ,1  I  title 

wr i tel  lul  ,2  I  idate 

wr i tel  lul  .3  I  ihour  ,imin  ,  i sec 

xou  t -xmax 

you i -do 

if  l i leg  eq  II  yout-ya 
writeilul  ,7)  xout  ,yout 
xout  -xmiri 
yout -ymi n 

writeilul  ,7)  xout  ,yout 
writeilul  ,5  I  ncomp 
I  00  cont inue 


phip-phih 

if  1 1 1 eg  eq  1  I  goto  120 
nbr-2 

x k -ha  1 fd*ds in l ph i p  I 
yk-hal ftdelyk 
goto  150 
'  20  cont inue 
nbr-  I 
xk-zero 
yk-zero 
'50  continue 

i bc-3- ibrnch 
xroin-zero 
ym in-zero 
ncomp-0 
igc-0 

do  5000  i b- I  .nbr 
iCurv-0 

if  (il eg  eq  I  or  isol  eq  II  icurv-l 


'  T? 


if  (isol  eq  3  and  txlibcl  ne  zero  and  ib  eq  ibrnch) 
4  i cur v- I 

i ben i - I 

if  lileg  eq  I  or  isol  ne  3)  ibent-0 

if  (tx(ibc)  eq  zero  or  ib  eq  ibrnch)  ibent-0 

ncx-nc ( ib ) 

i o f  f -25# l ib- 1  I 

ip- toff +25 

I x-z ( ip- I  I 

phi x-z lip) 

if  I i leg  eq  1  I  phix-phih 
maf  x-dcos  (ph  i  x-ph  i  f  )*inaf 
csa  fx-one/StCNT  I  mofx  ) 
snaf  x- 1 naf  x*csaf  x 
cosdp-dcos ( ph i x-ph i p ) 

s  f -zero 

do  210  ic-1  .ncx 

is-iof f+3#ic 
s  f  »s  f  »z 1 1 s  ) 

2  1  0  con l  I nue 

s  f -s  f  # 1  0d-  1 

xf ( 1  , ib  I *xk -s f *csa f x#cosdp 
yfll  ,  lb  )-y k -s f *snof x 
xf(2  ,ibl-xk+(lx+sfl#csaf x*cosdp 
yf(2  .  i  b  I  -  y  k  ♦  I l  x  ♦  s  f  )*snafx 
xmin-dmml  (  xmm  ,x  f  (I  >ib)) 
do  250  i-1.2 

ym i n-dm i  n  1  l  y  m  i  n  ,y  f  I  i  ,ib)l 

250  con ) i nue 

if  1 1  f  1 1  eq  0  !  go io  300 
igc-igc+1 

wr i leilut  .61  npo ini  I igc  ) 

300  continue 

npt  -0 
xg-zero 
yg-zero 
isym-5 

cal  1  VELVPT  I  i f  1 1) 

xsum0-zero 

ysum0-zero 


bsz 


SSumB-zero 
i  end-0 
i ver i -0 

do  1000  ic-1  ,ncx 

i x- io  f  f ♦ 1 2* ic 
i y- i x+3 
is-iof  f  +  3*ic 
xsuml -xsum0+z (  i  x  I 
ysuml -ysum0+z 1 i y  1 
ssuml -ssum0+z (is  I 
i sym-0 

if  ( i ben i  eq  1  )  goto  2000 

if  (lx  le  ssum0)  goto  1500 
if  ( 1  x  ge  ssum I  )  go ( o  1 200 
ils-1 
xq-lx 

if  ( i cur v  eq  1)  goio  1120 

i end- i 

coni  mue 

goto  1 300 

con  t i nue 

i  ls-2 

xg-ssumt 

if  ( ic  eq  ncx )  goto  1250 

if  lz(ix+ll  eq  zero!  qoto  1250 

col  1  SYMSNK 

goto  1 300 

con  1 1 nue 

i end- 1 

cont  mue 

if  (tend  ne  11  goto  1100 

if  (ib  ne  2 )  goto  1 100 

if  ( i so  1  ne  2  ond  isol  ne  3)  goto  1321 

tsym-3 

goto  1100 

cont i nue 

if  ( i leg  eq  3  )  goto  I  330 

isym-1 

goto  1100 

cont i nue 

i  syttt-2 

cont i nue 


xg-xg*csafx 

vg-xg*»nafx 

cal  1  WELVPT ( i f i  1  I 

if  ( i end  eg  II  goto  4100 

if  tils  eq  21  goto  3000 

con  f i nue 

ig-6* ( i b- 1  1*2*1 ic-l  1*1 
gxi -gcf  f ( lg ) 
gx2-gcf  f ( ig*l l 
call  ELVCAT (0  , i f 1 1 ) 
goto  3000 

coni inue 

if  lie  ne  1  1  go l o  2 1 00 
if  I ibrnch  ne  II  goto  2020 
lh-LENH ( ib  ,ncb  iZbl 
goio  2100 
con i i nue 

I h-LENH ( ia  ,nca  »za> 
con l i nue 
ssum2-Zero 
do  2150  i-l  incx 

j-ncx+ I  - i 

if  ( j  le  ic )  goto  2150 
j- lof  f ♦ 15* j 
ssum2-ssufn2+  2  I  j  I 
con i i nue 

i f  i  j ver i  eq  I)  goto  2500 
if  l  lx  1 1  ssumll  goto  2100 
xg-ssuml tesof  x 
VQ-xq* Inaf  x 

if  (Tx  eq  ssuml  )  goio  2220 

call  SYMSNK 

goio  2250 

coni i nue 

i ver i - 1 

i Sym-3 

coni inue 

call  WELVPTlifil  I 

goto  3000 

con i i nue 

xg- 1 x*csa f  x 

vg-xg*inafx 


5100 


5200 


wr i let lul  ,6  )  npoint(igc) 

con I i nue 

npi-0 

xg-zero 

yg-zero 

x  Sym-0 

call  UELVPT ( »  f i 1 ) 

if  (1  eq  zero  1  goto  5200 

t no fx-dcos <phi h-phx f  )#tnaf 

csaf x-one/StCNT ( tnafx  I 

xg-l*csafx 

yg-xg*  »nafx 

cal  1  UELVPT < i fx 1  I 


com  inue 

9X'“9’ 

gx2-g2 

Yx-l 

ssum0-zero 
ssuml -si 
xsum0-zero 
xsuml -xl 
ysuml -yl 
xs-55 
x  o  f  f-61 

call  ELVCAT ( 1  ,xfx 1 1 
ncomp-ncomp* I 
npo inil ncomp I -np  t 


6000  con  f i nue 
xmax-xout 


x  sym-7 

do  6200  i b— 1  .nbr 

if  (ifil  eq  0)  goto  6130 
igc-xgcH 

wr l leTlul  16 1  npoxnltxgcl 
do  6120  x-1  .2 

xou i -x  f  1 1  > ib  ) 
youi-y  f  1 1  >ib  1 

wnietlul  18  1  xout  (yout  iisym 
6 1 20  con » i nue 

6 1 30  con i i nue 

ncomp-ncomp+ I 
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ei  svs  f inal/t2for/symsnk  for#! 
subrou I i ne  SYMSNR 

************************************************************************ 
implicit  integer *2  ("I 
implicit  double  precision  (a-z) 

i  n  t  eger*2  i  leg  ■  i  s  t  ,nca  ,ncb  ,ma  ,n»b  ,  i  so  1  ,  ibrnch  ,uz  (5  I 
double  precision  z(67  )  >cz  ,cx  ,d  .ta  >tb 

common  /VCLOB/  1 1  eg  ,  i  s  t  >nca  ,ncb  ,z  icz  .cx  ,d  ,  t  a  ,  t  b  ,n»a  .n*b  , 

A  iso  I  •ibrnch  ,uz 

double  precision  pi  thalfpi  .degrad  .raddeg  .zero  ,one  ,hal f 
integer*2  izero  ,ione  ,it«o 

common  /VCONST/  pi  ,hal fpi  , degrad  .raddeg  .zero  .one  ,hal f  . 

A  i zero  ,  i one  ,  i t  *o 

double  precision  cosdp  >xk  ,yk  ,xg  ,yg  ,Qx1  ,gx2  .lx  .seglen  .xmm  ,ymin  , 

A  xmax  ,ssum0  .ssuml  ,xsum0  .xsuml  .ysumfl.ysuml 
real  xout  .yout 

integer  *2  isym  ,npt  ,ib  ,ncx  ,ioff  ,ic  ,ix  ,iy  .is  .ncomp  .npoint  15  I 
common  /VEL  VP  T /cosdp  ,xk  ,y  k  ,xg  ,yg  ,gx  1  ,gx2  , 1  x  >seg  1  en  ,xm  i  n  ,ym  i  n  , 

A  xmax  .ssum0  , ssuml  ,xsum0  , xsuml  ,ysum0  .ysuml  ,«oul  ,vout  , 

A  isym  ,np t  ,ib  ,ncx  ,ioff  ,ic  ,ix  ,iy  ,is  .ncomp  .npoint 

****************************  ******************************************** 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
C lmp-z ( is*2l 

if  (clmp  ge  zero)  goto  10 
isym-i 
goto  100 
1 0  con  1 1 nue 

if  (clmp  gt  zero)  goto  20 
i sym- I 
goto  100 
20  con  1 1 nue 
i 8ym-2 

1 00  con  t i nue 
return 
end 

* 


et  sys  f inal/i2for/»el vpi  forll 
subrout  me  WELVPT  C  i  f  1 1  1 

********************************************** *************** *********** 

implicit  integer*2  l" l 

in  teg er*2  i f i 1 

integer*2  screen  , key bd  ,lul  ,  1  u2  ,ni  v99  ,s  i  z99  ,ncpl 

integer*!  pref  I  (21  I  ,dum1  ,ext  1  (4  I  ,ext2(4  ) 

common  /LUNITS/  screen  ,keybd  ilu!  ,  Iu2  >ni  v99  ,s  i  z99  ,ncp1  , 

4  pref!  ,dum)  ,ext)  ,ext2 

double  precision  cosdp  ,xk  ,yk  ,xg  ,yg  >gx1  ,gx2  . 1 x  ,segl en  ,xmi n  ,ymin  , 

4  xmax  ,ssum0  ,ssuml  ,xsum0  ,xsum)  ,ysun>0,ysuml 
real  xoul  ,yOu t 

int  eger*2  I  sym  ,np  t  ,  ib  lOCx  ,  lOf  f  .ic  ,IX  ,iy  ,1S  .ncornp  .npoini  IS  ) 
common  /VELVPT /cosdr*  ,xk  ,y k  ,xg  ,yg  ,gx 1  ,gx2  . 1 x  ,segl en  ,xm in  ,ymin  , 

4  xmax  ,ssum0  .ssuml  ,xsum0  ,xsuml  .ysum0,ysuml  ,xoui  ,yout  , 

4  i  sym  ,np  l  ,  i  b  ,ncx  ,ioff  ,ic  ,ix  ,iy  ,is  ,ncomp  ,npo  i  n  t 

************************************************************************ 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 

xoul -xk+xg*cosdp 
you* -yk  +  yg 

if  (  i  f  1 1  eq  0  I  goto  ! 00 
writeflul  ,81  xoul  ,yOut  ,isym 
100  coni inue 
npt -npt  + 1 
return 

8  format(f8  2»1x,f8  2,i2) 
end 

* 
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et  sys  f inal/t2for/elvcot  forM 

subroutine  ELVCAT ( ir is >i f 1 1  1 

************************************************************************ 
implicit  integer *2  C **  1 
implicit  double  precision  (a-z) 

integer *2  ir is  ,i f 1 1 

integer*2  ileg.ist  ,nca  .neb  ,nwa  ,n»b  ,  i  so  I  ,  ibrnch  ,uz  15  ) 
double  precision  2 (67  I  ,cz  ,cx  ,d  , to  . rb 

common  /VCLOB/  i  leg  , i s t  ,nca  (ncb  .2  .cz  ,cx  ,d  , i a  , t b  ,n«a  ,n*b  , 

4  i sol  .ibrnch  ,u2 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  .one  ,hal f 
integer*2  i zero  . tone  , 1 1 wo 

common  /VCONST/  pi  .halfpi  .degrad  .raddeg  .zero  , one  .bo) f  , 

4  i zero  ,ione  ,i two 

double  precision  cosdp  .xk  ,y k  ,xg  ,yg  ,ax 1  ,gx2 , 1 x  ,segl en  ,xm i n  ,ymi n  , 

4  xmax  ,ssum0  .ssuml  ,xsum0  .xSuml  ,ysum0  .ysuml 
real  xou i  ,yout 

i  n  t  eger  *2  i  sym  ,np  t  ,  i  b  ,ncx  ,  lOf  f  ,iC  .ix  ,iy  ,is  .ncomp  ,npoi  n  I  1 5  ) 
common  / VELVPT/cosdp  .xk  ,yk  ,xg  ,yg  ,gx  1  ,gx2  ,lx  .seglen  ,xmm  ,ymm  , 

4  xmax  ,ssum0  , ssuml  ,xsum0  , xsuml  ,ysum0  , ysuml  ,xoui  .youl  , 

4  i  Sym  ,np  t  ,  ib  ,ncx  ,ioff  ,ic  .ix  ,iy  ,  i  s  .ncomp  ,npo  i  n  i 

mteger*2  nsegs  ,  i 

*  BEGIN  EXECUTABLE  CODE 

Ingxl-dloglgxl  ) 

SCop-SsumT-dmox 1  ( lx  ,ssum0  I 
nsegs- (scop*0  999999d0  ) /seglen* 1 
sgl-scop/nsegs 

wx-z ( is* 1  I 
hx-z ( tof  f ♦ 1 l 
hw-hx/wx 
•h-wx/hx 
i  sym-0 
xgof f-xg 
xxg-xo-xgof  f 
do  1600  i-l  .nsegs 

if  I i  ne  1 T  goto  1510 


L3Z 


I 


-*  3 

2  z 


temp-  ~hw*lngxt 

if  (temp  It  xxg  or  temp  gt  xsuml-xgoff)  goto  1510 
ymin-dm ini ( ymin  ,y k thw  +  gx^ I 
IS  10  coni  mue 

if  lifil  eq  0 1  goto  1700 
if  ( i  eq  nsegs  )  goto  1520 
lemp-gx  1  tdexp  (  whf xxg  ) 
temp-wh*sgl *hol ft  1 1 emp-one/ 1 emp  I 
t  emp- 1 emp+SECNT ( temp ) 
xxg-hw* (dlog ( temp J- Ingx 1  ) 
xg-xgof  f  *x*q 

yg-hw*hal f*T temp+one/temp  l  +  gx2 
goto  1 580 
1520  continue 

xg-xsuml 
yq-ysuml 

if  (iris  ne  1  )  goto  1550 
isym-3 
goto  1 580 
1550  continue 

if  (ic  eq  ncx  I  goto  1560 
call  SYMSNK. 
goto  1 580 
' 560  continue 

if  I i leg  ne  II  goto  1570 
isym-3 
goto  1 580 
1570  con  t i nue 

if  lib  ne  2 )  goto  1 580 
if  ( i leg  ne  21  goto  1575 
isym-3 
goto  1580 
1575  continue 

1 svm-2 

1580  continue 

col  1  WELVPT ( 1 f 1 1  l 
1 500  con  1 1 nue 

goto  1800 

1 700  corn  1 nue 

npt -npt  +nsegs 
xg-x8um I 
yg-ysumt 
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el  sys  f  ma  I  / 1 2for/plnpnt  fori# 

subroul i ne  PLNPNT ( i ov  ,  i f 1 1  ,  i  sw  1 

******** ********* ******************************************  ************* 
implicit  integer *2  (**) 
implicit  double  precision  (a-z) 

mteger*2  iov  >t  f  i  1  ,  isw 

i n t  eger*2  screen  ,keybd  ,  lu I  i  lu2  ,ni v99  ,s i z99  ,ncpl 

in  t  eger  *  I  pre  f  I  (2 1  I  .dum  I  ,ex  1 1  ( 4  )  ,ex  1 2 1 4  1  ,ex  i  3  I  4  )  ,ex  t  4  ( 4  | 

common  /LUNITS/  screen  ,keybd  , lul  ,  l u2  ,n i  v99  ,s  i  z99  ,ncpl  , 

4  pre  f  I  ,dum  I  ,ex  t  1  ,ex  t  2  ,ex  1  3  .ex  t  4 

i n t  eger  *2  i 1  eg  .  i s  t  ,nca  ,ncb  ,n*a  ,nwb  ,  i so  1  ,  i brnch  .uz ( 5  ) 
double  precision  z  <67  )  ,cz  .cx  ,d  .  ta  .  tb 

common  /VGLOB/  i  1  eg  .  i  s  t  ,nca  .neb  ,z  ,cz  ,cx  ,d  ,  t  a  .  t  b  ,n«a  ,nwb  , 

4  i sol  ,  i brnch  ,uz 
double  precision  za ( 25  I  .zb (25  I 
equ i va 1 ence  ( z ( I  1  ,za ( t  I  I  ,  ( z  <  26  )  ,zb ( t  )  I 

double  precision  ha  ,a  1  a  ,va  ,s  1  a  ,w  la  ,c  t  a  ,s2a  ,*2a  .c2o  ,s3a  ,**3a  , 

4  xa  .ya  ,x  la  ,x2a  ,x3a  .y  la  ,y2a  ,y3a  , 

4  i ana2a  ,  t  ana3a  .  t  ana4a  ,  t  ana5a  .  t ana6a  .  1  a  ,ph i a 
equ i valence  ( za ( 1  )  ,ha  )  .  ( za (2  I  ,al a  ,va  I  , 

4  ( za  ( 3  i  .si  a  )  ,  ( za  ( 4  I  ,#  I  a  I  ,  (za  (5  I  ,c  I  o  I  , 

4  (za(6)  ,s2a  I  .(za(7l  ,w2a  I  ,(za(8l  .c2a  I  , 

4  (za(9l  ,s3a)  ,(za(10)  ,«*3a  )  ,  ( zo  1 1  l  )  .xa  I  ,  ( za  u  2  i  .va)  , 

4  ( za(  1 3 )  ,x  1  a  I  .  iza  ( 1  4  1  ,x2a  )  ,  ( za  ( 1 5  )  ,x3o  I  . 

4  (zo(16)  ,yla)  .lzo(17)  ,y2a)  .  ( za ( I  8  )  ,y3a)  , 

4  lza( 19)  ,tana2a)  ,(za(20i  ,tana3a)  ,(za(2l  )  >tana4a)  , 

4  ( za (22  )  ,  tana5a  I  ,  ( za (23  I  .  tana6a  )  ,  t  za (24  I  ,1a)  ,  I za( 25 )  ,phi a ) 

double  precision  hb  .alb  .vb  ,slb  ,wlb  ,clb  ,s2b  ,»2b  ,c2b  ,s3b  ,w3b  , 

4  xb  ,yb  ,x lb  ,x2b  ,x3b  ,y  I b  ,y2b  ,y3b  , 

4  t  ana2b  ,  t  ana3b  .  t  ana4b  ,  t ana5b  .  i ana6b  ,  1 b  ,ph i b 
equivalence  (zb( 1  I  ,hb  I  ,  (zb (2  )  ,a1 b  ,vb  I  , 

4  ( zb  1 3  i  ,s  I  b  I  ,  ( zb  ( 4  l  ,w  I  b  I  ,  ( zb  ( 5  I  ,c  1  b  I  , 

4  (zb (6  I  ,s2bl  ,  ( zb ( 7  )  ,w2b  1  ,(zb(8)  ,c2b)  , 

4  (zb (9)  ,s3b )  , (zb( 10)  ,w3b  )  ,(zbt 1 1  )  ,xb  )  ,(zb( 12  I  ,vb  )  , 

4  (  zb  (13)  ,xib  l  ,(zb(  14  I  ,x2b  1  ,(zb(l5  1  ,x3b  )  , 

4  (zb(  16  1  ,y1b  I  ,(zb(  17  1  ,y2b  1  ,  (zb  (  1  8  )  ,v3b  )  . 

4  ( zb ( 1 9  1  .  tana2b  1  .  ( zb (20  1  ,tana3b  I  ,  (zb (2  I  I  ,  t ana4b  )  , 

4  ( zb (22  I  ,  tana5b  )  ,  (zb (23  1  ,  tana6b )  ,  I  zb  124 )  .  1 b  1  . 1  zb ( 25 1  ,phib ) 

double  precision  coi  1  ,slp  ,frct  ,c3  ,s4  ,»4  ,x4  ,y4  ,tana7  , tanaS  .1  , 

4  h.phih.rtot  .xtot  ,ztot  ,do 


0L2 


equivalence  ( z  (51  )  ,coi 1  I  ,(z(52)  ,slp)  ,  I  z (S3  I  ,frcr )  ,  Iz 151 )  ,c3 )  , 

A  (z(SSI  ,s1l  .(z(56l  .wll  ,(z(S7)  ,x1  I  ,(z<S8l  ,y1l  , 

A  (z(S9)  ,rana7)  , lz( 60)  ,iana8)  .(z(61  )  ,1  )  , 

A  (z (62  I  ,h  I  ,  ( z (63  )  ,ph i h 1  , 

A  (  z  ( 61  1  ,rloi  )  > l z  ( 65  )  ,xioi  I  > (  z  1 66  )  ,z  i o t  )  ,  (  z  ( 6 7  )  ,do  ) 
integer *2  nc(2  I 
equ i va 1 ence  ( nca  ,nc ) 
double  precision  tx(2l 
equivalence  (ta.txl 

double  precision  pi  ,hal fpi  , degrad  .raddeg  .zero  .one  ,hal f 
integer *2  i zero  .  i one  ,  i t wo 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,ha) f  , 

A  izero  ,ione  ,  i two 

double  precision  inaf  .phif 
common  /VOFLR/  inaf.phif 

double  precision  delyk  , t wod  .ha  1 fd  ,dsq 
common  /VANCH/  delyk  ,  i wod  ,ha 1 f d  .dsq 

i n  r  eger  *  I  i  i  t  1  e ( 50  I  .  i f i I e ! 32  )  ,o  f i I e ( 32  I 

common  /TITLES/  t i i 1 e  .  i  f i 1 e  ,o T i 1 e 

i n i eger *2  1 2  T  ■  I e ( 1 6  I  ,o2  f  i  1  e  (  1 6  I 

equ i va 1 ence  (ifile.i2file)  .(ofile  .o? file) 

i n i eger *2  i da i e ( 5  I  > i hour  ,  i m i n  ,  i sec 
common  /DAT  I  ME/  i da i e  .  i hour  ,  i m i n  ,  i sec 

integer*!  cvarin(l72l 
common  /VARIN/  cvarm 

integer*!  cvarol (210  1  .cvaro2( 1 00  ) 
common  /VAROUT/  cvarol  .cvaro2 

double  precision  dduml(!3l, 

A  gal  I  ,ga!2  .ga2!  ,ga22  .ga3l  ,ga32  , 

A  gbl 1  ,gbl2  >gb2l  .gb22  .gb3l  .gb32  , 

A  gl  .g2  ,ddum2  (  3  ) 
common  /VARC/  dduml  , 

A  gall  ,gal2.ga2!  ,ga22  ,ga31  ,ga32  , 

A  gbll  ,gbl2,gb2l  .gb22  .gb3l  .gb32  , 

A  gl  .g2  .ddum2 

K) 

<1 


I 


double  precision  gcfMI2) 
equivalence  (gall  .gcffl 

integer*!  cunkno(12) 
common  /UNKNOV/  cunkno 

integer*!  cgroptHil 
common  /GROPT/  cgropt 

integer*)  cgrp21  (21 8  I  .cgrp22 182  ! 
common  /CRP2CN/  cgrp21  ,cgrp22 

doub l e  precision  cospx  ,si npx  ,xk  ,zk  ,xxg  ,lx  ,zmin  ,zmax  , 

4  ssum0  ,ssuml  ,xsum0  .xsuml 
real  xout  ,zout 

i nt eger*2  i sym  ,np l  , ib  ,ncx  ,  lOf  f  ,ic  itx  ,is  ,ncomp  ,npoi n l  I S  ) 
common  /VELVPT/cospx  ,smpx  ,xk  ,zk  ,xxg  ,lx  ,zmm  ,zmax  , 

4  SSum0  ,ssum I  ,xsum0  ,xsum!  ,xout  ,ZOut  , 

4  isym  ,npt  ,ib  ,ncx  ,ioff  ,ic  ,ix  ,is  .ncomp  ,npo  i  n  t 

integer*2  nbr  ,ibc  .icurv  ,ibent  ,ip  , 

4  tend  ,  i ver  f  ,  i I s  ,  i g  ,  i g  t vp  ,  i  ,  j  ,n  ,  i gc 

integer*)  ans  l  1  I  .yes 
data  yes/  '  Y  '/ 

************************************************************************ 
*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
i f  ( i f 1 1  eq  l  )  goto  30 

wr i te I  screen  ,*  )  'Do  you  want  lo  save  output  for  plan  views?' 
read  I keybd  ,* I  ans 
if  (ansttl  eq  yes)  goto  20 

lSW-1 

goto  9000 
20  con  t  mue 

cal  1  RWC0M1 ( 1  ) 
goto  100 

30  com  mue 

if  ( i sw  eq  1  )  goto  9000 
if  ( iov  eq  I  I  goto  50 
cal  1  AOOEXT  ( i  f  i  le  ,31  ,exH  I 
call  f 1 1 e ( 1 2 f 1 1 e  ,  1 u l  >3) 


I 


2  72 


goto  55 
50  com  inue 

call  ADOEXT (of x le ,31  ,extAI 
call  f i le(o2fx le  ,lul  ,3  I 
55  com  mue 
igi yp-3 

wr  1 1 e  1  lul  ,A  1  i g t  yp 

»r i (e ( lu 1  , 1  1  f  i  r  1  e 

«r  x  re  ( lul  ,2  I  xdote 

*r  x  re ( iul  ,31  xhour  ,  inun  ,  i sec 

xoul -xroax 

zoul-jmax 

wriiellul  ,7)  xoul  ,ZOul 
xout-0  0 
z out -zmxn 

wrxietlul  ,7  I  xou t  ,zOut 
»r  i  tel lul  ,5 1  ncomp 
100  com  inue 

if  I i leg  eq  II  goto  120 
nbr-2 
zK -hal fd 
goto  150 
1  20  con  t  x  nue 
nbr-  1 
zk-zero 
150  com  inue 
x  k  -zero 
i  bc-3- x  bench 
zm i n-  -ho  I f d 
zmax-  hal fd 
ncomp-0 
xgc-0 

do  5000  xb-1  ,nbr 
i cur v-0 

if  (ilea  eq  1  or  isol  eq  1)  icurv-l 

xf  (xsol  eq  3  and  ixlibci  ne  zero  and  xb  eq  xbrnch) 
4  xcurv-1 

xbent-1 

if  1 1  leg  eq  I  or  xsol  ne  3)  tbem-0 
xf  (txlibcl  eq  zero  or  xb  eq  xbrnch)  ibem-0 
ncx-nc ( x  b I 


lof f-2S*l ib-1  I 
ip- iof  f  *25 
1 x-z ( ip- 1  I 

phi x-z ( ip  ) 

if  ( 1 1  eg  eq  1  )  ph i x -ph i h 
cospx -dcos l ph i x ! 
sinpx-dsmlphi  x  I 
tnaf  x-dcos l phi x-phi f 1*  tnqf 
csaf  x-one/SECNT ( tnaf  x ) 
snafx- tnafxScsafx 

i f  ( i f i I  eq  01  goto  300 
igc-igc+1 

•nteTlul  >61  npointligc) 

con t i nue 

opt  -0 

xxg-zero 

i sym-5 

call  WPLNPT ( i f i 1 1 

xsum0-zero 
ssum0-zero 
i end-0 
i ver  t -0 

do  4000  ic-1  ,ncx 

ix-iof  f *  1 2* ic 
is- tof  f  +  3* ic 
xsum  1  -XSUHI0  +  Z  (  i  x  ) 
ssuml  -ssum0+z  1  i  s  I 
isym-0 

if  ( i bent  eq  II  goto  2000 

if  (lx  le  ssum0  I  goto  1500 
if  (lx  ge  ssuml)  goto  1200 
i  Is-  1 
xxg-  I  x 

if  ( i cur v  eq  II  qo to  1120 

i end- 1 

coni i nue 

goto  I  300 

com  i  nue 

i  ls-2 

xxg-ssum I 


1250 
I  300 

1320 

1330 
I  300 

1500 

2000 

2020 

2100 

2150 


if  ( ic  eq  next  goto  1250 

if  (z(ix+l)  eq  zero  I  goto  1250 

call  PLNSNK 

goto  1300 

con? inue 

i end- t 

coni inue 

if  I  lend  ne  1)  goto  M00 
if  lib  ne  21  goto  1300 

if  ( i so  1  ne  2  and  i so  I  ne  3 )  goto  1 320 

lsym-3 

goto  1300 

con  J i nue 

if  1 1 leg  eq  31  goto  1 330 

l  sym-3 

goto  1300 

coni inue 

i sym-2 

cont inue 

xxg-xxg*csa  f  x 

call  WPLNPT l i f i 1  I 

if  ( i end  eq  I  1  goto  3100 

if  tils  eq  21  goto  3000 

coni i nue 

cal  1  PLNCAT  (0,i  (,  1  J 
go  t  o  3000 

con l i nue 

if  lie  ne  I )  goto  2100 
if  ( ibrnch  ne  II  goto  2020 
lh-LENHl ib  ineb  >zb  1 
goto  2100 
cont inue 

Ih-LENH ( ta  (nca  ,za I 
cont inue 
ssum2-zero 
do  2150  i-l  ,ncx 
j-ncx* I  -  i 

if  ( j  le  ic  I  goto  2150 
j-ioff+15+j 
ssum2-ssum2+z ( j  1 
con  1 1 nue 

if  (ivert  eq  II  goto  2500 


SL2 


I 


2220 

2250 

2100 

2500 

2520 

2530 

2540 

2600 

3000 

4000 


if  (lx  It  ssuml  I  goto  2400 

xxg-ssuml tcsaf x 

if  tlx  eq  ssuml  )  goto  2220 

call  PLNSNK 

goto  2250 

coni inue 

ivert-1 

i sym-3 

com  inue 

col  1  VPLNPTl i f i 1 ) 
goto  3000 
com  mue 
xxg- 1 x*csaf  x 
ivert -1 
i  sym-3 

cal  I  UPLNPThfil  ) 
com  inue 

if  (ssum2  ge  lh)  goto  3000 
if  lie  eq  ncx )  goto  2520 
cal  1  PLNSNK, 
goto  2600 
con  t i nue 

if  (ib  eq  2)  goto  2530 

i sym-0 

goto  2600 
com  i  nue 

if  lileg  ne  21  goto  2540 

isym-4 

goto  2600 

com  mue 

i sym-2 

com  inue 

cal i  WPLNPT ( i f i 1  I 

com  inue 
xsum0»xsum1 
ssum0-ssumt 
com  mue 


4100 


con  1 1 nue 

ZZ-ZOUt 

zmin-dmml (zmtn  ,zz ) 


zmax-dmaxl (zmax  ,zz ) 
nc  omp - nc omp  *  I 
npo i n l t  ncomp )  -np  I 
zk-  -zk 

5000  con  t 1 nue 

zdoi 1 -zero 

if  ( i 1 eg  eg  I )  goto  6000 
xk-  xxgicospx 
zk-  -zf *xxq*s inpx 

cospx-dcosTphih ) 

smpx-dsm(phih) 

zdoi t-zk-xk*sinpx/cospx 

if  ( i f 1 1  eg  0 )  go r o  5 1 00 

igc-igc+t 

nr i  teTlu)  ,6)  npo t nr Ijgc) 
5100  cont  inue 
npt-0 
xxg-zero 
i  sym-0 

cal  1  WPLNPT ( i f  i  1  1 

if  (1  eq  zero)  goio  5200 

i naf x-dcos Iph t h-ph i f )*tnaf 

csafx-one/SECNT ( inafx  ) 

xxg-l*csafx 

call  WPLNPT ( j  f . 1  ) 

5200  coni  mue 
xsuml -x4 

cal  1  PLNCAT (1  ,i  f  i  1  ) 
ncomp-ncomp+ 1 
npo i n  t ( ncomp ) -np  t 

6000  continue 
xx-xout 
zz-zour 
xmax-xx 

zmin-dminl  Izmm  »zz  I 
zmax-dmax 1 (zmax  >zz  ) 

i  svm-7 

if  ( i  f i 1  eg  0 )  goto  6130 
i  gc-igct- 1 

»r  i  teTlul  >6  I  npomtligc) 


ei  svs  f  inal/t2for/plnsrtk  forM 
subrout  me  PLNSNK 

************************************************************************ 
implicit  integer *2  («) 
implicit  double  precision  (a-*) 

i n  t  eger  *2  1 1 eg  .  i s  t  ,nca  ,ncb  ,n«e  ,n*b  ,  i so 1  .  i br neb  ,uz 1 5 ) 
double  precision  *  167  1  ,cz  ,cx  ,d  >ta  , tb 

common  /VCLOB/  i  leg  list  (nca  int:b  ,z  .cz  ,cx  .d  >ta  >tb  ,n«a  ,nwb  , 

&  isol  ,ibrnch  ,uz 

double  precision  pi  .halfpi  .degrad  .raddeg  .zero  ,one  ,hal f 
integer*2  i  zero  ,i  one  ,i  nno 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  ,hal f  . 

A  i zero  ,  i one  ,  i  n»o 

double  precision  cospx  .sinpx  ,xk  ,zk  ,xxg  ,lx  ,znun  .zrnax  , 

A  SSum0  .ssuml  ,xsum0  .xsuml 
real  xout  ,zout 

integer  *2  isym  ,npt  ,ib  ,ncx  ,  iof  f  .ic  ,ix  ,is  .ncomp  .npomi  (5  I 
common  /VEL VPT /cospx  ,smpx  ,xk  ,zk  ,xxg,|x  ,znun  .zrnax  , 

A  ssum0  , ssuml  ,xsum0  , xsuml  ,xout  ,zout  , 

A  i  svm  ,npf  .ib.ncx.ioff  .ic.ix.is  .ncomp  ,npo  i  n  i 

************************************************************************ 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
C lmp-z ( is*2l 

if  tclmp  ge  zero  I  goto  10 
isym-'A 
goto  1 00 
10  con  t  mue 

if  (clmp  gt  zero  I  goto  20 
iSym-1 
goto  100 
20  cont i nue 
i sym-2 

100  cont  mue 
re  t  urn 
end 

* 


-4 


A 


r 


e'  svs  f inal/t2for/*plnpt  forU 
subrout me  WPtNPT 1 1 f i 1  ) 

********************************************************* ****** ********* 

implicii  mteger*2  I ■ I 

integer *2  i f i 1 

mteger*2  screen  ,keybd  ,lul  ,lu2  ,ni  v99  ,siz99  ,ncpl 

integer*  I  pref  1  (211  ,duml  .ex  tl  Ml  .ex  i2  M  ) 

common  /LUNITS/  screen  ,keybd  . lu I  ,lu2  ,ni v99  ,s i z99  ,ncp!  . 

A  pref  l  ,dum  I  ,ex  t  I  ,ex  1 2 

double  precision  cospx  .sinpx  ,xk  ,2k  ,xxg  ,|x  ,2mm  >2max  , 

A  ssum0  iSSuml  ,xsum0  .xsuml 
real  xout  ,20ut 

1 ni eger *2  1 sym  ,np  t  ,  1 b  ,ncx  ,  iof  f  ,  ic  ,  1 x  ,  1 s  .ncomp  ,npo i nt ( S  ) 
common  /VEL VPT /cospx  ,smpx  ,xk  ,2k  ,xxg  ,|x  ,2mm  .zmox  , 

A  SSum0  .ssuml  ,xsum0, xsuml  ,xOut  ,ZOut  , 

A  1  sym  ,np  1  , 1  b  ,ncx  ,  1  o  f  f  ,ic  ,ix  ,is  , ncomp  ,npo  1  n  1 

**********************************************  ***************** ********* 

*  BECIN  EXECUTABLE  CODE 

************************************************************************ 
xou  t-xk  *xxg*cospx 
20ul-Zk*xxg*smpx 
if  ( 1 f 1 1  eq  01  goto  100 
writeUul  ,81  xout  ,20ut  ,isym 
1 00  con  1 1 nue 
npl -npt ♦ 1 
return 

8  format  (f8  2ilx,f8  2,i2) 
end 


280 


I 


pi  sys  f mal/l2for/plncat  forH 

subrouf  me  PLNCAT  (ins  >1  f  1 1  I 

******* ***************************************************************** 
implicit  integer *2  ("I 
implicit  double  precision  (a- 2  I 

integer *2  iris.ifil 

mteger*2  ileg.ist  ,nca  ,ncb  inwa  ,nwb  .isol  .  i  brnch  ,uz  ( 5  I 
double  precision  z  (67  I  ,cz  .cx  ,d  .  t  a  ,tb 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  ,z  ,CZ  ,cx  ,d  ,ta  ,tb  ,n*a  ,ni»b  , 

4  i so l  ,  i brnch  ,uZ 

double  precision  pi  .halfpi  , degrad  .roddeg  .zero  ,one .ha  1 f 
mteger*2  i zero  ,  ione  , i t wo 

common  /VCONST/  pi  ,hal fpi  .degrad  .raddeg  .zero  ,one  ,hal f  , 

4  i zero  ,  i one  .  i t  mo 

doub  1  e  precision  cospx  fs  i  npx  ,  x  k  ,zk  ,xxg,lx  ,zm  i  n  ,zm  ax  , 

4  ssumB  iSSum 1  ,xsum0  .xsuml 
real  xout  ,zout 

integer*2  isym  ,npt  ,ib  ,ncx  , lof  f  >ic  ,ix  ,is  ,ncomp  .npoini  (5  I 
common  /VEL  VPT  /cospx  ,s  inpx  ,x  k  ,z  k  ,xxg,lx  ,z  mm  ,zmax  , 

4  ssum0,ssuml  .xsum0  , xsuml  ,xout  .zout  , 

4  i  sym  ,np  I  ,  ib  ,ncx  ,  i  o  f  f  ,ic  ,ix  ,iS  ,ncomp  ,npo  i  n  I 

************************************************************************ 
*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
i svm-0 
xxg-xsum I 

if  (mis  ne  II  goto  1550 
i sym-3 
goto  1 580 
1550  continue 

if  (ic  eq  ncx  I  goto  1560 
call  PLNSNK. 
goto  1 580 
1 560  con t i nue 

if  ( i leg  ne  ll  goto  1570 
i sym-3 
goto  1580 
15  70  com  mue 

if  (ib  ne  21  goto  1 580 


00 


et  sys  f inal/t2for/moor04  TorM 
program  MOOR04 

********** ************************************************************** 
implicit  integer*2  («) 

mteger*2  screen  , key bd  , lul  i lu2  ,n i v99  >s i z99  ,ncp I 
i  n  i  eger  *  1  pre  ft  (21  I  ,duml  ,ext1  Ml  ,ex  1 2  M  I  ,ex  t  3  M  I  ,exHMI 
common  /LUNITS/  screen  .keybd  ,  lul  .  I  u2  ,n  i  v99  ,s  i  z99  ,ncpl  , 

A  prefl  ,duml  ,extl  ,ex  t2  ,ex  1 3  .ex  M 

i n  t  eger  *2  abu  f  f ( 2*  I  >1 ugra  f  ,  1  up  t  f 1  .1 udbug 
common  /GCB/  gbu f f  . I ugra f  , lup t f 1  ,1 udbug 

integer *2  i leg  , i s t  ,nca  ,ncb  ,nwa  ,nwb  , i sol  , i brnch  ,uz (5  I 
double  precision  z  (67  I  ,cz  ,cx  ,d  ,  t  a  ,t  b 

common  /VCLOB/  i  1  eg  ,  i  s  t  ,nco  ,ncb  ,Z  .CZ  ,cx  ,d  ,  t  a  ,  l  b  ,nwo  ,n*b  , 

4  isol  ,  i brnch  ,uz 

integer *2  npoint 
real  hmin  ,hmax  ,hsym 

common  /VHXCRV/  hm i n  ,hmax  ,hsym  ,npo i n t 

double  precision  pi  ,hal fpi  .degrad  .raddeg  .zero  .one  .half 
mteger*2  izero  .ione  ,i  two 

common  /VCONST/  pi  .hal fpi  , degrad  .raddeg  .zero  .one  ,hal f  , 

4  i zero  ,  i one  ,  i t  wo 

double  precision  tnaf.phif 
common  /VOFLR/  tnaf  .phi f 

double  precision  de  1  yk  , t wod  ,ha I  fd  ,dsq 
common  /VANCH/  de  1  y  k  . t wod  .hal fd  ,dsq 

integer *2  1 1  ib  ,i key  .iov 
integer*!  ans ( I  I 

integer*!  yes 
data  yes/  ' Y  ' / 

************************************************************************ 
*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
cal  1  bfact (0  ,  M40LV  '  I 
i 1 ib-l 
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et  svs  f inal / t 2 for/hxcalc  fort# 
subroul ine  HXCALC 

*ttttt****t************t******************t****t****t*******t*tt*******t 

i mp I i c i  l  i  n  t  eg er *2  ( “ ) 

i  n i eaer *2  i  leg  ,  i  s  t  ,nca  ,ncb  ,nwa  ,n*b  ,  i  so  1  ,  i  brnch  ,uz  ( S  I 
double  precision  z  (67  I  ,cz  ,cx  ,d  .  t  a  ,  f  b 

common  /VCLOB/  i  leg  ,isi  ,nca  ,ncb  ,Z  ,cz  ,cx  ,d  ,ifl  ,ib  ,n»a  ,n»b  , 

A  isol  ,  i brnch  ,uz 

mteger*2  iscopa  .iscopb  ,  i tana  ,  i tanb  , i t  ,is 
double  precision  epsv  .gamma  ,se 

common  /VCMPO/  eps v  .gamma  ,se  ,  i scopa  ,  i scopb  ,  i t ana  ,  i i anb  ,  i i  ,  i s 
integer *2  Mold 

double  precision  ss0  ,dt en0  ,ss 1  ,d t enl  ,ss2  ,d t en2  ,s 1 p0  ,sa0  ,sm in ( ? ) 
common  /vEQUAL/  ss0  ,d t en0  ,ss  1  >d t  en f  ,ss2  ,d t  en?  ,s  I p0  ,sa0  ,sm  i n  , 

A  i  told 

equ  i  va  1  ence  ( sm  i  n  (  I  I  ,sam  ml  ,  I  sm  i  n  (2  I  ,sbm  j  n  l 

double  prec ision  sa  ,sb  ,ca  ,cb  ,vc0a(6  i  ,vc0b(6  i  , 

A  ee*0  ,eez(?  ,eev0  ,a0  ,b0  ,ph,a0  ,phib0 
mteger*2  icase 

common  /VSP10/  sa  ,sb  ,ca  ,cb  ivc0a  ,vc0b  , 

A  eex0  ,eez0  ,eev0  ,a0  ,b0  ,phia0  ,phib0  » 

A  icase 

double  precision  snphih  .esphih  ,snafh  ,csofh  ,tnafh  ,scafn  .dsnph 
common  /VHOIR/  snph i h  ,csph i h  ,sna fh  ,csa fh  ,  t na (h  , sea fh  ,dsnph 

double  precision  htnafh  ,h*A  ,wAh  ,s^wAh  ,c3h 
common  /VHVEC/  htnafh  ,hv»A  ,wAh  ,sA»Ah  ,c5h 

double  precision  epsxz  ,xz iru (2  I  ,xzbas (2  I  ,hbas <2 I  .sera r I ( 10  I 
common  /VCSSXZ/epsxz  ,xztru  .xzbas  ,hbas  ,scrat I 
double  precision  x iru  ,z tru  (xbas  ,zbas  ,hbasx  .hbasz 
equivalence  Ixztrull  )  .xtrul  .(xziru(21  .ztrul  . 

A  (xzbasM  )  .xbas  I  ,(xzbast2l  .zbas  I  , 

A  l hbas  1 1  l  .hbasx  1  ,  (hbas 1 2  I  ihbasz I 

i n t eger*2  i tan t 

double  precision  a  .b  .snphi  ,mafa  ,tnafb  , 

A  seco7  ,seca8  ,ut  ,s  t  .y  k  t  ,zk  t  ,eex  ,eez  ,eey  ,ybuov 
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/  c>b 


common  /VCSSHP/  a  (b  ,snphi  ,inafa  ,tnafb  > 

&  seca7  ,seco8  ,ut  ,st  ,yk  r  ,zk  t  ,eex  ,eez  ,eey  ,ybuoy  ,1  rani 

integer *2  ivs 

double  precision  v0  ,vl  ,v2  , f 0  , f 1  ,(2  ,(  ,eps 
common  /V SEC/  v0  ,vl  ,v2  tf0  ,fl  if 2  if  ,eps  ,ivs 
double  precision  varray ( 3  )  i farray 1 3  1 
equ i valence  ( v0  , varray  1  .( f0  i f array  I 

inteqer*2  ilh0,ilhl  ,ilh2,il 
double  precision  Ih0,lh1  ,lh2,ce 

common  /VSCOIL/  |h0,|hl  ,  1 h2  ice , i 1 h0  ,  i lh t  ,ilh2iil 
inreger*2  i lh(S  I 
double  precision  lh(31 
equivalence  ( t 1 h  ,  i 1 h0  )  ,  ( 1 h  ,  lh0  1 

double  precision  xred 

integ er*2  isidf  ,nerra  ,nerrb 

common  /VSTAB/  xred  .isidf  ,nerra  .nerrb 

*«:M***** *************************************************************** 

»  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
if  ( i leg  ne  1  )  goio  100 
call  ovl i nk (  'HXCLC 1  '1 

goio  200 
1  00  com  mue 

coll  ov 1  ink ( 'CPREP0  'I 
if  (ileg  eq  31  call  CPREP1 
coll  CPREP2 

call  ov I  ink (  'HXCLC2  t 
200  coni inue 
re  r  urn 
end 

* 
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et  sys  f inal/t2for/hxclc1  fortt 
subroutine  HXCLC1 

ttttt ***********»**************»****t******:M******* ******************** 
implicit  integer*2  (*»l 
implicit  double  precision  (a~z) 

mteger*2  screen  ,keybd  ,lul  ,  lu2  ,n  t  v99  ,s  i  z99  ,ncp! 

i  n  teger  *  1  pre  f  I  121  I  ,dum  I  ,ex  till!  ,ex  i?H  I 

common  /LUNITS/  screen  ,keybd  ilul  , lu2  ,n  1  v99  ,s  i  z99  >ncpt  ■ 

A  prefl  ,duml  ,extl  ,ext2 

i  n t eger*2  i  1  eg  ■  i s  t  ,nca  >ncb  ,n«a  ,n*b  ,  i  so  1  >  i brnch  ,uz  ( 5  ) 
double  precision  z(67  )  ,cz  ,cx  ,d  ,ta  ,fb 

common  /VCLOB/  i  leg  ,ist  ,nca  ,ncb  ,z  ,cz  ,cx  >d  ,ta  ,tb  ,n*a  ,nwb  , 

A  isol  .ibrnch  ,uz 
double  precision  za ( 25  )  ,zb 1 25  I 
equivalence  ( z ( 1  I  ,za (1  )  )  ,  ( z (26  )  ,zbi  1  )) 

double  precision  ho  ,a) a  , va  ,s 1 o  ,w 1  a ,c 1  a  ,s2a  ,w2a  ,c2a  ,s3a  ,*3a  , 

A  xa  ,ya  ,x  la  ,x2a  ,x3a  ,y  1  a  ,y2a  ,y3a  , 

A  i ana2a  ,  t  ana3a  ,  t  ana4a  ,  t  ana5a  1 1 ana6a  ,  1  a  ,ph i a 
equi  valence  I  za  M  1  ,ha  I  ,lza(2)  ,a  I  a  ,va  1  , 

A  l  zal  3  )  ,s  1  a  I  ,  l  za  M  1  ,w  1  a  I  ,  (  za  (5  )  ,c  1  a  >  . 

A  lza(6)  .s2a  I  ,(za(7)  ,w2ai  ,(za(8)  ,c2al  . 

A  (za  19  1  rs3a  )  ,  (  za  M  0  1  ,w3a  I  ,  (  za  M  1  I  ,xa  I  ,  I  za  it  2  I  ,ya  1  . 

A  (za(13i  ,xla)  > l za ( 1 4  I  ,x2al  ,  ( za ( 1 5  I  .x3a)  , 

A  (za (161  ,ylal  ,(za(1  7)  ,v2al  ,(zaM8l  ,y3a)  , 

A  l  za  (  1 9  1  ,  t  ana2a  I  ,  ( za  ( 20  I  ,  tana 3a  I  ,  (  za  ( 2 1  >  ana“ta  )  , 

A  l za (22  1  ,  t anaSa  I  ,  ( za (23  I  ,  tana6a  )  > ( zo  24  ),  I  a  i  ,  I za ( 25  )  ,ph i a ) 

double  precision  hb  ,alb  ,vb  >slb  ,»ylb  iclfc  >s2b  .w2b  >c2b  .s3b  ,w3b  , 

A  xb  iyb  ixlb  ,x2b  ,x3b  ,y!b  ,y2b  iy3b  , 

A  t  ana2b  >  t  ana3b  1 1  analb  .  t  ana5b ( t  ona6b ,1b ,ph i b 
equivalence  (zb( 1  )  ,hb )  ,!zb(2)  ,alb  ,vb)  , 

A  ( zb  ( 3  )  ,s  l  b  )  ,  ( zb  ( 4  I  ,w  1  b  l  ,  ( zb  ( 5  1  ,c  1  b  I  , 

A  (zb  (6  )  ,s2b  i  ,  ( zb  (  7  i  ,w2  bi  ,(zb(8i  ,c2b  I  , 

A  (zb (9)  ,s3b  1  ,  (  zb (  10  I  ,w3b  I  ,  ( zb  (  I  1  )  ,xb  1  ,  (  zb  I  1  2  )  ,yb  I  , 

A  l zb  1 1  31  ,x  1  b  )  ,  lzb(  I  4  l  ,x2b  1  ,lzb(  15  I  ,x3b  )  , 

A  (zbl  16  I  ,y1b  1  ,Izbl  17  )  ,y2b  1  ,  (zb(  1  8  I  ,y  3b  I  , 

A  ( zb ( 1 9  1  1 1 ana2b  1  > l zb ( 20  I  ,  t  ana3b I  ,  ( zb ( 2 1  >  ,  t ana4b  )  , 

A  ( zb (22  1  ,  tana5b  )  ,  (zb (23  )  ,  tana6b )  ,  (zb  124  )  ,1b)  ,  I  zb  1 25 )  ,phjb ) 

double  precision  coi  1  ,slp  ,frct  ,c3  ,s4  ,»4  ,x4  ,y4  ,iana7  ,tana8  ,1  , 

A  h  ,phih  ,r  lot  ,xtot  iZtot  ,do 

equivalence  (z (5 1  1  ,coi 1  1  ,  ( z (52 1  ,s 1 p )  ,  ( z (53  )  ,  frc  t 1  ■  I z (54  1  ,c3  1  , 

A  ( z  (55  1  ,s4  )  ,  (z  ( 56  )  ,»4  1  ,fz(57)  ,x4)  ,  (  z  (58  )  ,y4)  , 
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4  (z (59 )  , i ana 7 )  , (z 160 )  ,tano8 )  , (z 161 ) >1 )  , 

4  Iz  (62  )  ,h  )  >(z  (63  )  .phihl  , 

4  (  z  161 1  ,r  tot  )  ,  (z  <65  I  ,xiot  1  ,(z  (66  I  ,z  rot  )  ,  ( z  (67  )  ,do  ) 

double  precision  b  ,sinb  ,cosb  ,tanb  ,secb 

equi valence  (z (25 ) >b  )  , lz (26 )  ,si nb  )  , ( z (27  >  ,cosb  )  ,  ( z (28  )  ,t  anb I  , 

4  ( z (29  )  ,secb ) 

integer *2  npoint 
real  hmm  ,hmax  ,hsym 

common  /VHXCRV/  hmm  ,hmax  ,hsym  .npomt 

double  precision  pi  ,hal fpi  , degrad  .raddeg  .zero  ,one  ,hal f 
mteger*2  i zero  , i one  . i t *o 

common  /VCONST/  pi  ,hal fpi  , degrad  , raddeg  .zero  ,one  ,hal f  , 

4  i zero  , i one  .lino 

double  precision  sa  ,sb  ,ca  ,cb  ,vc0a (6  !  ,vc0b  (6  /  , 

4  eex0  ,eez0  ,eey0  ,a0  .b0  .phia0  ,phib0 
integer*2  icase 

common  /VSPID/  sa  ,sb  ,ca  ,cb  ,vc0a  ,vc0b  , 

4  eex0  ,eez0  >eey0  ,a0  ,b0  ,phia0  .phib0  , 

4  icase 

integer  $2  ncomp  ,npt  ,  k  ,isg,iws 

real  xmox  ,xinin  ,xcoord  ,delh  ,dbmax  .hcoord 

equivalence  (ncomp  ,npt  ,  k  )  ,(dhmax  .hcoord  I 

************************************************************************ 
*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
eps-ye*l  0d~l0 
delb- (hmax-hmin  1/ (npo mt - t  1 

ha-hmax*l  0d3 

cal  1  SEC1  Vinca  ,zo  ,smb  ,cosb  ,tanb  >secb  ieps  ,0  ) 
xmax-xa 

*r i te ( lut  ,7  1  xmax  ,hmax 

if  (hmm  eq  0  0)  goto  120 
ha-hmjn*)  0d3 

coll  SEC  1  V  (nca  ,za  ,s  mb  ,cosb  ,  tanb  ,secb  ,eps  ,0  I 
xm i n-xa 
goto  190 
120  cont  mue 
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call  SUMSC  (nca  >za  ,sa  ica ) 
xmm-  (sa-ya  l*cosb/(one-smb ) 

1 90  coni inue 

wntellul  >7  1  xmm  ,h#in 

ncomp- 1 

wriie(iul  ,5  I  ncomp 
dhmax-delhtl  0e-2 

if  (hsym  ge  hmm  and  hsym  le  hmax  I  goto  220 
isg-  -t 
goto  255 
220  coni inue 
isg-0 

do  250  *  -  I  ,npo i n  f 

if  (obs(hsym-hmm- (k-1  l*delh)  ge  dhmax )  goto  250 
isg-k 
goto  255 
250  con i i nue 

255  com  inue 

npl-npoinl 

if  (isq  eq  01  npt-npomt  +  l 
»r  i  l  e  (  Tul  >6  )  np  i 

i  ws-0 

do  1000  k-1  ,npoim 

hcoord-hmin* (k- I Ikdelh 

if  I  ms  ne  0  or  isg  ne  0  or  hsym  ge  hcoord)  goto  500 
ha-hsvmkl  0d3 

cal  1  SEC  I V  (nca  iza  ,s  mb  ,cosb  ,  tanb  .secb  ,eps  ,0  ) 
xcoord-xa 
i sym-5 

•ritellul  ,8  I  xcoord  ,hsym  , i sym 
iws-1 

500  coni inue 

i sym-0 

if  ( i sg  eq  k 1  i sym-5 
if  ( k  ne  II  goto  550 
xcoord-xm i n 
goto  900 
550  com  inue 

if  (k  ne  npoini I  goto  600 


oa 
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xcoord-xmax 
goto  900 
600  Cont inue 

ha-hcoord*1  0d3 

cal  1  SEC  1  V  Inca  ,za  ,s  mb  ,cosb  ,i  anb  ,secb  .eps  ,0  ) 
xcoord-xa 
900  con  1 1 nue 

write!  lul  ,8  1  xcoord  ihcoord  , i sym 
if  Ik  ne  I00*(k/100))  goto  1000 
wr  i  tel  screen  ,10  )  k 
1000  continue 

cal  1  closet lul  1 
return 

5  f  orma  f  t 1 2  ) 

6  formal ( i5  1 

7  formaitfS  2,lx,f8  21 

8  format(f8  2,1x,f8  2,i21 

10  format  Mx  ,'  JUST  COMPLETEO  POINT', Ml 
end 


290 


ei  sys  f mal / t 2 for/hxc lc2  forli 
subrout  me  HXCLC2 

t**t*t*tt*t****tt**t*t*%***t****t*t*tt****t**t*t***t**t*ttttt****ttttt** 

implicit  inteaer*2  (“1 
implicit  double  precision  (a-zl 

integer»2  screen  .kevbd  ,  1 u 1  1 1 u2  ,n i v99  ,s i z99  ,ncp I 

i  r> t eger*  t  pre f  I  ( 21  1  ,dum1  ,ext  I  M  I  ,ex  t  2  I  3  ) 

common  /LUNITS/  screen  .keybd  , I ut  , lu2  ,n i v99  ,s i z99  ,ncpl  , 

&  prefl  .durnl  ,ex  t  I  ,ex  1 2 

i n t eger*2  i leg  , i s  t  ,nca  .neb  ,n*a  .nmb  .  i so  I  ,  i brnch  ,uz ( 5 ) 
double  precision  z (67  I  ,cz  ,cx  ,d  .  ta  ,  tb 

common  /VGLOB/  i  leg  .  i s t  .nca  ,ncb  ,z  ,cz  ,cx  ,d  , t  a  ,  i b  ,nwa  ,n*b  , 

A  l sol  .Ibrncb  ,UZ 

double  precision  za(2S  I  .zb(2S  ) 

equi valence  (z ( 1  )  ,za( 1  I  )  .  Iz (26  )  ,zbt I  1  I 

double  precision  ha  ,ala  .va  ,sla  ,wla  .cla  .s2a  ,w2a  ,c2a  ,s3a  ,w3a  , 

4  xa  ,ya  ,x  I  a  ,x2a  ,x3a  .y  I  a  .y2a  ,y  3a  , 

A  t  ana2a  ,  i ana3a  ,  i ana3a  .  t ana5a  .  t ana6a  .  1  a  ,ph i a 
equ i valence  ( za( 1  1  .ha  I  .  ( za (2  I  ,al a  .va  )  , 

4  lza(3l  ,slai  ,(za(3)  ,wiai  .IzaiSi  .cla)  , 

4  (za(6)  ,s2a  I  ,(za(71  ,m2o  1  .  ( zo  ( 8  )  ,c2a  )  , 

4  (za  (91  ,s3a)  .(za(!0)  ,«*3a  (  .(za(l  I  I  rxa)  ,  (  za  (  1 2  t  ,val  > 

4  ( za(  I  3  I  ,x  I  a  )  ,  (  za(  I  3  I  .*2a  )  ,  (  za(  1 5  I  ,x3a  )  , 

4  ( za  ( 1 6  )  .y  I  a  I  ,  ( za f  I  7  I  ,y2a  I  ,  (za  (  18  )  .y  3a  )  , 

4  ( za (19)  ,iana2a )  ,  l za 120  I  ,tana3a  )  ,  ( za (2 1  )  ,  i ana3a  )  , 

4  (za(22  )  i  tanaba  )  .  (za(23 )  ,  i ana6a )  ,  I za 1 23  )  ,) a  )  ,  I za (25  )  >ph ia ) 

double  precision  hb  .alb  .vb  .slb  ,wlb  ,c!b  ,s2b  ,«*?b  .c2b  .s3b  ,w3b  , 

4  xb  ,yb  ,xlb  ,x2b  ,x3b  ,y  lb  ,y2b  ,y3b  , 

4  t  ana2b  ,  t  ana3b  .  t ana3b  .  t ana5b  .  t anaBb  .  1 b  .ph i b 
equivalence  ( zb 1 1  )  ,hb  I  .(zb  12  l  .alb  ,vb  )  , 

4  ( zb  ( 3  1  ,s  1  b  )  ,  (  zb  ( 3  I  ,w  I  b  I  ,  l  zb  ( 5  I  ,d  b  l  , 

4  ( zb  ( 6  1  ,s2b  )  .  ( zb  (  7  I  ,*2b  I  ,  ( zb  ( 8  i  ,c2b  )  , 

4  (zb  (9  1  ,s3b  1  ,(zb(  10  I  ,w3b  I  .  (  zb  (  I  I  1  ,xb  1  ,  (zb  M2  I  .yb  I  . 

4  ( zb  ( I  3  1  >x  1  b  )  ,  ( zb  (  1  3  )  ,x2b  I  .  (  zbi  15  )  ,x3b  )  . 

4  ( zb  ( 16  )  ,y  lb  1  ,  ( zb  ( I  7  i  ,y2b  I  ,(zb(  18)  ,v3b)  , 

4  ( zb ( 1 9  )  .  t  ana2b  )  .  ( zb ( 20  I  ,  t ana3b  I  .  ( zb  1 2 1  )  ,  t ana3b  )  . 

4  ( zb (22 )  ,  tana5b )  .  ( zb ( 23  )  ,  tana6b )  ,izb!23)  ,)b)  ,(zb(25)  .ph ib ) 

double  precision  coi  I  ,slp  ,frci  ,c3  .s3  ,*3  ,x3  ,y3  ,tana7  ,tana8  >1  , 

4  h.phih.rtot  ,xtoi  .ztot  .do 

equivalence  lz  (51  )  .coi  1  >  .(zl52)  ,slp)  ,lz(53)  ,frct  )  ,lz(53)  ,c3 )  , 

4  ( z  (55  I  ,s3  I  ,  (z(56  I  ,»3l  , ( z  (57  l  ,x3)  ,(z(58!  ,y3  )  . 


&  l z 1 59  1  ,  i ana 7  I  ,  1 z 1 60  )  ,  t  ana8 )  ,(2(61  )  ■  i >  > 

4  ( z  (62  1  ,hl  ,(z(63)  ,ph  i  h  )  , 

4  (2 (64  I  ,r ioi  )  ,  (z (65 )  >x t ot  I  ,  ( z (66 )  ,z lot  )  ,  ( z (67  )  ,do  ) 

double  precision  b  ,sinb  ,cosb  ,tanb  ,secb 

equivalence  (2(25) ,b )  , (z (26 )  ,si nb )  ,(2(27)  ,cosb ) ,12(28)  ,lanb )  , 

4  <z(29)  ,secb) 

integer*2  npoint 
real  hmin  ,hmax  ,hsym 

common  /VHXCRV/  hmin  .htnax  ,hsym  ,npo i nt 

double  precision  pi  .halfpi  , degrad  .raddeg  .zero  , one  ,hal f 
integer*2  i zero  , i one  , i t wo 

common  /VCONST/  pi  ,hal fpi  , degrad  ,raddeg  .zero  .one  ,hal f  , 

4  i zero  , tone  , i l wo 

double  precision  sa  ,sb  ,ca  ,cb  ,vc0a ( 6 1  ,vc0b 1 6 )  . 

4  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  ,phib0 
integer*2  icose 

common  /VSPIO/  sa  ,sb  ,ca  .cb  ,vc0a  .vc0b  , 

4  eex0  ,eez0  ,eey0  ,a0  ,b0  ,phia0  .phib0  , 

4  icase 

integer *2  ncomp  ,np i  ,k  , i sq  , i ws  , i s t or  r 
real  xmax  ,xmin  .xcoord  ,delh  ,dhmax  ,hcoord 
equivalence  (ncomp  ,npi  , k  )  ,  (dhmax  .hcoord  ) 

************************************************************** ********** 
*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
delh- (hmax-hmin 1/ Inpo int -  1  I 

h-hmax*1  0d3 
call  CSXHP(0) 
xmax-r  to  t 

wri te( lul  ,7 l  xmax  ,hmax 

if  (hmin  eq  0  0)  goto  120 
h-hmm*1  0d3 
call  CSXHPI01 
xmm-r  tot 
goto  190 
1 20  cont inue 

h-delh*0  5e3 


h-dminl  (h  ,(ce*cb+c3+s,1*w4  1*1  0d-4  I 
coll  CSXHP 10) 
xmin-r  tot 
h-hal f*h 
cal  1  CSXHP ( I  I 
xmm-rlot+rtot-xmin 
1 90  con » i nue 

write! lul  ,7)  xmin  ,hmin 

ncomp- 1 

«n  tellul  ,5)  ncomp 
dhmax-delh*1  0e-2 

if  (hsym  ge  hmm  and  hsym  le  hmax  I  goto  220 
isg-  -1 
goto  255 
220  cont inue 
isg-0 

do  250  k-1  .npoint 

if  labs  (hsym-hmm- I  k  - 1  )*del  h  J  ge  dhmax  )  goto  250 
isg-k 
go  t  o  255 
250  cont inue 

255  con  1 1 nue 

npt -npoint 

if  lisa  eq  01  npt -npoi n t ♦  1 
wr i tellul  ,6 1  npt 

iws-0 

do  1 000  k -  I  ,npo i n  t 

hcoord”hmin+ I k - 1  )*delh 

if  (iwS  ne  0  or  i sg  ne  0  or  hsym  ge  hcoo rd)  go 
h-hsym*l  0d5 
call  CSXHP ( 1 ) 
xcoord-r  tot 
t  sym-5 

wr i tellul  .81  xcoord  .hsym  ,  i sym 
iws-1 


xcoord-xmm 
goto  900 
50  con  1 1 nue 

if  ( k  ne  npo i n t  )  goto  600 
xcoord-xmax 
goto  900 
00  cont i nue 

h-hcoord* 1  0d3 
istar t-0 

i f  C  h  ge  3  1  i s  r  ar l -  I 
cal  1  CSXHPI istart  I 
xcoord-r  tot 
00  con  1 1 nue 

write(lu1>8)  xcoord  .hcoord  ,iSym 
if  ( i  leg  eq  3  and  k  ne  10*0/10))  goto  1000 
«r  i  te (screen  ,101  k 
00  cont i nue 

cal  I  closet  lull 
re  t  urn 

5  format ( i2 I 

6  f ormat ( 1 5  I 

7  format  (  f8  2  ,lx  ,f8  21 

8  format(f8  2, lx,f8  2,i2> 

10  format  (lx  , -JUST  COMPLETED  POINT'  ,t4  1 


ei  svs  f inal/t2for/csxhp  (orit 
subroutine  CSXHP ( is t ar t ) 

************************************************************************ 
implicit  imager *2  («1 

mteger*2  is  tart 

integer *2  i leg  ,isr  ,nca  ,ncb  ,n»a  ,n»b  ,isol  ,  ibrnch  ,uz 15 ) 
double  precision  2  (67  )  ,C2  ,cx  ,d  ,ta  ,tb 

common  /VCLOB/  1  1  eg  .  1  s  1  ,nca  (ncb  ,2  ,C2  ,cx  ,d  ,  t  a  ,  tb  ,n«a  ,n«*b  , 

A  1  sol  .ibrnch  ,u2 

************************************************************************ 

*  BEGIN  EXECUTABLE  CODE 

************************************************************************ 
call  CPREP3 

if  ( 1  leg  eq  21  goto  100 
call  CSSHP 
goto  500 
1 00  con  t 1 nue 

cal  1  CSEHPl i star t  1 
500  com  1  nue 
return 


i  I 


-I  r 
<*  ,  v* 


et  svs  f inal/t2for/moor05  forM 
program  MOOR0S 

************************************************************************ 

implicit  integer*2  (i-n  ,«l 

integer* 1  i  f  t  Te ( 32  I  ,ans (1  )  , 1 1 1 1 1 e 152  t  . ida t e  M 0  I  , 1 1 ime ( 8 ) 
mi eger *2  i gnome ( 1  I  )  ,  Idc  < 11 1  . 1 v» ( 11 )  ,pv» (II), 

&  i  ver  t  (  1 8  I  .tips  (18)  >y  fee  r  II 8  I  <z  fee  t  118) 
d i mens i on  x ( 250  I  ,v 1 250  I  ,  i sym ( 250  I  ,1 f i 1 e I  1 6  ) 
equ i va 1 ence  (ifilell  I  ,  1  f i 1 e i I  II 
integer*2  i  first  ,mgo 

integer*  1  pref  1  (21  I  ,ex  1 2  (  *  I  ,ex  t  3 M  I  ,e»  t  4  (  4  I  .blant  ,s  I  ash  ,yes 
data  ext2/'  L0C'/,ext3/'  ELV  V  ,ex  1 4/  *  PLN/  .blant/ ■  '/.slash/  /  / 
data  yes/  'V '/  .teybd/9/  .iscren/10/  ,lu/8/ 

data  ldc/'LOAD  DEFLECTION  CURVE  '/  ,1  v*/  ELEvAT  ION  VIEW  '/ , 

4  pvw/'PLAN  VIEW  '/ 

data  t ips/ ' Ver t ical  Axis  h  m  tips  divided  by  '/ 
data  y feet / 'Ver t ical  Axis  y  in  feet  divided  by  '/ 
data  /feet/ 'Ver t ical  Axis  z  m  feet  divided  by  / 

*************************************  ************ 

*  BEGIN  EXECUTABLE  COOE 

************************************************************************ 

*  Assign  display  screen  to  lu  10 

************************************************************************ 

col  1  assignl  dc  '  .10) 
call  glu( iscren I 

************************************************************************ 

*  Read  user  input  file 

************************************************************************ 
cal  1  chrs i z ( 3  l 
call  erase 

»r i tel iscren  ,*  I  'Enter  library  name  ’ 
read( teybd  .*  I  pref I 
do  5  i-l  .21 

j-22-i 

if  (prefl(j)  eq  blant  I  goto  5 
ncpl-jt-l 

pref l tncpl  I -si ash 
goto  6 

5  cont  mue 
ncpl -0 

6  con  t  mue 

do  8  i  - 1  ,32 

i f i le( i  l-blant 


8  com  inue 

i f  ( ncp I  eq  01  goto  10 
do  9  i-1  .ncpl 

i f i le ( i  1-pre  fl(i) 

9  con  t i nue 

i  f i rs  t - 1 
10  com  i  nue 

wr  i  let  iscren  ,*  )  'Emer  file  name  ' 
j - 3 1 -ncpl 

read  1 keybd  ,*  )  i f i le (ncpl  ♦  I  1  j 
•riisliscren  ,t)  'Emer  graph  type  ' 
wr i re< iscren  ,*  1  '  1  -  load  displacement 

«ri tel iscren  ,*  I  '  2  -  elevation  view' 

wr i tel iscren  ,*  1  '  3  -  plan  view' 

read  I keybd  ,*  )  i graph 
if  I i graph  ne  11  goto  11 
call  ADOEXT 1 1 f i le  ,31  iext2i 
goto  13 
1  l  com  i  nue 

if  I i graph  ne  21  goto  12 
call  XdDEXT ( i f i le  ,31 
goto  13 

1 2  com  i  nue 

call  ADOEXT l i f i le  ,31  ,ext4l 

1 3  corn i nue 

call  f  1 1  e  1 1  f  i  I  e  ,  I  u  ,2  >  i  s  t  a  t  ) 
if  I i s  t  a  t  eq  0  l  go  to  IS 

wr  i  tel  iscren  ,H)(ifile(i  1  ,i-1  ,301  ,lu,istet 
M  format  1 1  x  ,30a1  ,i 3  ,i 3  1 
go  to  100 

15  com  i  nue 

read(lu,18)  i graph 

18  format (ill 

read! lu  ,19 )  ititle 

1 9  f  orma t 1 50a  1  I 
read(lu,33)  id ate 

33  f orma* 1 1 0a  1  1 
read! lu  ,31 1  1 1  ime 

34  forma* (Sail 
readllu,*!  xxmax  ,yymax 
read!  lu  i*  I  xxmm  ,yymin 


I 


?  I 


Curve ' 


LbZ 


reodllu,*)  ncomp 

************************************************************************ 

*  Initialize  titles  depending  on  type  of  graph 
************************************************************************ 

goto  (20.23,261,  i graph 

20  com  mue 

do  21  i-l  ,11 

i gnome ( i  I  - 1 dc ( i  1 

21  cont  mue 

do  22  i-l  ,18 

i ver ili  I  -k ips I i  1 

22  cont  mue 

goto  29 

23  cont  mue 

do  24  i-1,11 

i gnome ( i  I-l vw( i  I 
2^  continue 

do  25  i-l  ,18 

i ver  t ( i  I  -  y  fee  t ( i  I 

25  cont  mue 
goto  29 

26  cont  mue 

do  27  ,-1,11 

i gnome ( i  I  -pvw ( i  I 
2  7  con  t i nue 

do  28  i-1,18 

iver t ( i i-zfeet (  i  1 
28  cont  mue 

2>  continue 

************************************************************************ 

*  Gisplov  first  7  records  for  verification 
************************************************************************ 

mgo-0 

30  com  i  nue 

cal  1  chrs i z ( 4  1 
cal  1  hibrn8( 10) 

write! iscren  ,31  if i gnome ( i 1  ,i  -  1  ,111 

31  format (///5x  ,1 1 o2  1 
cal  I  chrs  t  z ( 3  1 

cal  1  hibrn8( 10  1 

wr i te ( i scren  ,*  1  '  output  title  '.ititle 

wr  i  te  (  i  scren  ,*  I  '  dote  '.idate,'  time  *,itime 

wr 1 1 e ( i scren  ,*  1 '  w  of  segments  ’,  ncomp 


-o 

oo 


wr i t  e ( i  scren  ,* I  ‘  xmin  '  ,xxm in  > '  xmax  '  ,xxmax 

wr  i  let  t  scren  ,*)'  ymm  '  ,yymm  , '  ymax  ivymax 

************************************************************************ 

*  Allow  user  ro  alter  x  ,y  mm/max 

************************************************************************ 

if  (ifirst  eq  I  or  mgo  eq  II  goto  35 
wr i tel i scren  ,*  I 

«ri tel iscren  I  'Do  you  want  to  use  your  previous  selection  of  gra 
4ph  op  t i ons?  ' 
read  I Keybd  ,*  I  ans 
if  (ans Ml  eq  yes  I  goto  A5 
35  coni inue 

write! iscren  ,*  I 

wr i tel i scren  ,*  I  'enter  desired  xmin  * 
read l Keybd  ,*  I  xmin 

wr i te ( i scren  ,*  I  enter  desired  xmax 
read ( Keybd  ,*  I  xmax 

wr  i  te  (  iscren  ,*  i ‘enter  desired  ymm  * 
read!  Kevbd  ,*  I  ymm 

wri tel iscren  ,1  I  enter  desired  ymax 
read ( Keybd  ,»  I  ymax 

************************************************************************ 

*  User  enters  step,  scaling  4  ticKs  for  x  ,y 
************************************************************************ 

wr i tel iscren  ,*  l  enter  step  size  for  x  axis  ' 
read! Keybd  ,*  l  xstep 

»r i tel iscren  ,*  I  'enter  scaling  factor  for  x  axis 
read l Keybd  ,*  I  ixscal 

»ri teliscren  ,*  I  enter  step  size  for  y  axis 
read l Keybd  ,* I  ystep 

»r i te! iscren  ,*  I  'enter  scaling  factor  for  y  axis 
read  I Keybd  ,*  1  lyscal 

wri tel iscren  ,*  I  ’enter  number  of  minor  t icK  intervals  per  step  for 
4x  axis 

read  I Keybd  i*  1  ixtiK 

wr i tel iscren  ,*  I  'enter  number  of  minor  t icK  intervals  per  step  for 
4y  axis 

read l Keybd  i*  I  lytiK 

wr i t e ( i scren  ,* I 'do  you  want  a  grid?  ly  or  n)' 
read l Keybd  ,* I  ans 
igr id-3 

if  Ians  II  I  ne  yes  I  igrid-0 
wr i te ( i scren  ,*  I 


_  Zj 


*ri ie( iscren  ,♦  I  'Do  you  want  to  modify  the  graph  options  you  hove 
ijust  selected"?' 
read! keybd  ,*  1  ans 
if  (ans  111  ne  yes  I  goto  40 
cal  1  erase 
i ngo- 1 
goto  30 
40  com  mue 

************************************************************************ 

*  Appiy  seal  mg  factors 

********* ****** ************* **************** **************** ************ 

xmi  r,-xm  i  r/ 1  xscol 
xmax -xmax/ i xsca 1 
xs  tep-xs  tep/ i xsca 1 
ymin-ymin/iyscol 
ytr.ax-ymax/ lySCol 
ys  tep-ys  tep/ i yscal 

************************************************************************ 

*  Expand  plot  window  boundaries  to  coincide  with  major  ticks  marks 

**********************************************«***«*****'  I************** 

xm  i  n-xni  i  n/xs  t  ep 

xym- i n  t  ( xm i n  1 

if  (xmin  It  0  0  and  xmin  ne  xym)  xym-x,m  )  0 
xm i n-xym*xs  t  ep 
xmox-xmox/xs  tep 
xym- i n  t  I xmox  ) 

if  (xmax  gt  0  0  and  xmax  ne  xym)  xym-xym»l  0 

xmax-xym*xstep 
ym i n-y m in/ysi ep 
xym- i n t  ( ym i n  ) 

if  'ymm  It  0  0  and  ymm  ne  xym)  xym-xym-t  0 

ymin-xym*ystep 

ymax-ymox/ys tep 

xym- i n  t ( ymax  ) 

if  (ymax  gt  0  0  and  ymax  ne  xym  I  xy.n-xym*l  0 
ymox-xym*ys t  ep 

************************************************************************ 

*  Erase  screen  and  write  titles  on  screen 
************************************************************************ 

45  cont inue 
i f irs  t-0 
cal  1  erase 

wr i r  e ( i scren  ,1  )  ( i do  t e ( i  )  ,  i - 1  ,10)  ,  ( i gnome  I i  )  ,  i -  1  , 1  I  ) > 


300 


4  ( i » i  me  ( i  I  ,  i  - 1  ,8  > 

cal  1  chrs i z  M ) 
cal  1  hibrn8( 101 

»n  ie(i  scran  ,2  1  (  i  l  i  t  1  e I  i  I  » i  - 1  .50  I 
cal  1  chrs i z 1 3  I 
cal  1  hibrn8< 10  I 

on  tel  i scren  ,3  1  (  i  ver  t  I  i  1  ,  i  - 1  1 1 8  )  ,  i  y sea  1  , i  xsca  1 

1  forma  i  1 1  x  ,  'Da  le  '  ,1 0a  1  i2Sx  ,  I  1  a2  ,2Sx  , 'Time  ’  ,8a  1  I 

2  formal  I /2Sx  .50a I / 1 

3  f  orma  ill*  >1 8a2 , 1 4  i26x  , 

4  'Horizontal  Axis  x  in  feet  divided  by  ,  i4 I 
************************************************************************ 

*  Oraw  axis  .labels  ,  tick  marks  4  grid  by  plotting  a  dummy  data  point 
********************************** ******** ******* *********************** 

cal  1  mi  t 

call  page  I -30500  .32000  ,-24000  ,230001 

cal  1  1 inel 11 

cal  1  gridl igr idl 

call  xtickslixtikl 

call  y  t i ck  s I i y  t i h  I 

call  xy 1  in ( xmi n  >xs 1 ep  ,xmax  ,ym in  ,ys  tep  ,yma* 1 

call  x  1  ab  1 1  ,4  ,-  1  ,3  I 

cal  1  y  1  ab  I  I  ,4  ,- 1  ,3  ) 

call  plotlxmin.l  ,ymin,l  ,1  1 

** ********************************************** ************** ********** 

*  Iteration  to  plot  all  segments  including  ocean  floor 

*  Npomt  is  the  «  of  data  points  within  one  segmem 
************************************************************************ 

do  250  i-l  ,ncomp 

read!  let  ,*  I  npomt 
n-0 

50  corn  inue 

i  save-0 

t  f  (npoint  le  250)  go  to  60 
isave-npoint -249 
npomt -250 
60  cont  mue 

************************************************************************ 

*  Reod  data  points  and  symbol  value,  normalize  x  ,y  with  scaling  factor 
************************************************************************ 

npt  -npomt  -n 
con  t i nue 
do  150  j-l  ,npt 


100 


k  -j+n 

read  ( l  u  ,*  I  x  ( k  )  ,y  ( k  I  >  i  sym  ( k  ) 
x  (  k l-x ( k 1/ 1 xsca 1 
y(k )-y  (k )/iyscal 
)  50  con l i nue 

************************************************************************ 

*  Plot  data  points,  symbol  7  represents  ocean  floor 
******************************************* ************* ************** ** 

if  (lSym(l)  eq  7)  cal  1  Imelf  I 
cal  1  symbol (0 ) 

call  plot2(x(l),l,yM)|l  ,npo  int  1 
if  1 1  sym  Ml  eq  7)  go  to  250 

************************************************************************ 

*  Place  symbols  on  line  just  drawn, 

*  save  y  data  point  for  ocean  surface  if  buoy  I sym  -  5) 

************************************************************************ 
do  200  j-1  .npoinf 

i Sym j - i sym ( j  ) 

if  (isymj  eq  0)  goto  200 

cal l  symbol l i symj 1 

call  plot2 1 x ( j  )  ,1  ,y(j)  ,1  ,1  ) 

if  (isymj  eq  3  and  igrapb  eq  21  ysave-ylj) 

200  con  t i nue 

************************************************************************ 

*  If  more  than  250  data  points,  save  last  x  ,y  .symbol 

*  Reset  npoint  to  remaining  «  of  points 
************************************************************************ 

if  (isave  eq  0 t  go  to  250 
npoint- isave 
n- 1 

x 1 1 )-x (250 l 
yll  1-y (2501 
isym( I  1-0 
go  to  50 
250  con  r i nue 

************************************************************************ 

*  If  elevation  view,  draw  ocean  surface 
************************************************************************ 

if  l i graph  ns  21  go  to  300 
call  line(3) 
x ( 1  1-xmin 
y ( 1  1-ysave 
x (2  )-xmax 


30  Z 


y 12 )-ysave 

call  p  1  o  1 2  ( x  ( 1  )  ,1  ,y(t  I  ,1  ,2) 

300  com  inue 

************************************************************************ 

*  Display  and  frame  graph 

********************1*************************************************** 
cal  1  frame 

************************************************************************ 

*  Replol  same  file? 

************************************************************************ 
cal  1  readf k ( keys  ) 

*  if  (keys  eq  0 1  go  lo  300 
cal  I  erase 

wr i te ( i scren  ,*  I  do  you  wish  to  plot  this  file  again?  !y  or  n)‘ 

read( keybd  ,*  1  ans 

if  (ansi  11  ne  yes)  go  to  350 

rewind  lu 

go  to  15 

************************************************************************ 

*  Plot  a  different  file? 

************************************************************************ 

350  com  inue 

wr i te ( i scren  ,*  I  'do  you  wish  to  plot  another  file?  ly  or  n)‘ 

read ( keybd  ,*  1  ans 

i f  (ansi  II  ne  yes  I  go  to  300 

cal  1  close (lu  ) 

go  to  10 

300  coni inue 

call  closeflul 

stop 

end 

* 


30  3 


END 
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